Problems defining excel range to paste array into from outlook - arrays

Question

I am using the following script to take information from an email body as a 1D and put it into excel. It was working well but recently it has started throwing an error when it comes to pasting the range. I think it is a simple problem with defining the range but I can't understand why? I have tried a few ways of doing it and it always fails somewhere. Sample data here: http://pastebin.com/mXZAWD90
The code is triggered from outlook, if this makes a difference?
Sub _to_excel()
On Error GoTo 0
Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("mapi")
Dim ThermoMail As Outlook.MailItem
Set ThermoMail = Application.ActiveInspector.CurrentItem
On Error Resume Next
Set xlObj = GetObject(, "Excel.Application")
On Error GoTo 0
If xlObj = Empty Then Set xlObj = CreateObject("Excel.Application")
xlObj.Visible = True
xlObj.Workbooks.Add
Dim msgText, delimtedMessage, Delim1 As String
delimtedMessage = ThermoMail.Body
'Remove everything before "Lead Source:" and after "ELMS"
TrimmedArray = Split(delimtedMessage, "Source:")
delimtedMessage = TrimmedArray(1)
TrimmedArray = Split(delimtedMessage, "ELMS")
delimtedMessage = TrimmedArray(0)
TrimmedArray = Split(delimtedMessage, "Address:")
TrimmedArray(1) = Replace(TrimmedArray(1), ",", vbCrLf)
delimtedMessage = TrimmedArray(0) & "Address:" & TrimmedArray(1)
Dim pasteRange As Range
'Split the array at each return
messageArray = Split(delimtedMessage, vbCrLf)
'PROBLEMS START HERE
'paste the split array into the worksheet
lastRow = UBound(messageArray) + 1
pasteRange = ActiveSheet.Range(Cells(1, 1), Cells(lastRow, 1))
ActiveSheet.pasteRange = WorksheetFunction.Transpose(messageArray)
Call splitAtColons
ThermoMail.Close (olDiscard)
End Sub

Answer 1

You're missing a Set statement and pasteRange is not a property of Activesheet - it is a Range variable, so:
Set pasteRange = ActiveSheet.Range(Cells(1, 1), Cells(lastRow, 1))
pasteRange.Value = WorksheetFunction.Transpose(messageArray)

Answer 2

#Siddharth Rout's suggestion was the answer. I properly defined activesheet using Dim ws As Worksheet and then was able to eliminate the use of pasteRange. I think the problems partially stemmed from issues using ActiveSheet when the code was triggered from outlook.
Sub Thermo_to_excel()
On Error GoTo 0
Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("mapi")
Dim ThermoMail As Outlook.MailItem
Set ThermoMail = Application.ActiveInspector.CurrentItem
On Error Resume Next
Set xlObj = GetObject(, "Excel.Application")
On Error GoTo 0
If xlObj = Empty Then Set xlObj = CreateObject("Excel.Application")
xlObj.Visible = True
xlObj.Workbooks.Add
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
Dim msgText, delimtedMessage, Delim1 As String
delimtedMessage = ThermoMail.Body
'Remove everything before "Lead Source:" and after "ELMS"
TrimmedArray = Split(delimtedMessage, "Source:")
delimtedMessage = TrimmedArray(1)
TrimmedArray = Split(delimtedMessage, "ELMS")
delimtedMessage = TrimmedArray(0)
TrimmedArray = Split(delimtedMessage, "Address:")
TrimmedArray(1) = Replace(TrimmedArray(1), ",", vbCrLf)
delimtedMessage = TrimmedArray(0) & "Address:" & TrimmedArray(1)
'Split the array at each return
messageArray = Split(delimtedMessage, vbCrLf)
'paste the split array into the worksheet
lastRow = UBound(messageArray) + 1
ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, 1)).Value = WorksheetFunction.Transpose(messageArray)
Call splitAtColons
ThermoMail.Close (olDiscard)
End Sub
Edit
Try this
Sub Thermo_to_excel()
Dim myOlApp As Object, mynamespace As Object
Dim ThermoMail As Object
Dim msgText, delimtedMessage, Delim1 As String
Dim oXLApp As Object, oXLWb As Object, oXLWs As Object
Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("mapi")
Set ThermoMail = Application.ActiveInspector.CurrentItem
delimtedMessage = ThermoMail.Body
'~~> Establish an EXCEL application object
On Error Resume Next
Set oXLApp = GetObject(, "Excel.Application")
'~~> If not found then create new instance
If Err.Number <> 0 Then
Set oXLApp = CreateObject("Excel.Application")
End If
Err.Clear
On Error GoTo 0
Set oXLWb = oXLApp.Workbooks.Add
Set oXLWs = oXLWb.Sheets("Sheet1")
'Remove everything before "Lead Source:" and after "ELMS"
TrimmedArray = Split(delimtedMessage, "Source:")
delimtedMessage = TrimmedArray(1)
TrimmedArray = Split(delimtedMessage, "ELMS")
delimtedMessage = TrimmedArray(0)
TrimmedArray = Split(delimtedMessage, "Address:")
TrimmedArray(1) = Replace(TrimmedArray(1), ",", vbCrLf)
delimtedMessage = TrimmedArray(0) & "Address:" & TrimmedArray(1)
'Split the array at each return
messageArray = Split(delimtedMessage, vbCrLf)
'paste the split array into the worksheet
lastRow = UBound(messageArray) + 1
With oXLWs
.Range(.Cells(1, 1), .Cells(lastRow, 1)).Value = _
oXLApp.WorksheetFunction.Transpose(messageArray)
End With
Call splitAtColons
ThermoMail.Close (olDiscard)
End Sub