Problems defining excel range to paste array into from outlook

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

Change `ActiveSheet.Range(Cells(1, 1), Cells(lastRow, 1))` to `ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(lastRow, 1))` — Siddharth Rout, Nov 28 '14 at 12:22
Also you should avoid the use of `Activesheet`. You may want to see [this](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros/10718179#10718179) — Siddharth Rout, Nov 28 '14 at 12:24
Thanks Sid, using this I was able to remove the use of pasteRange completely and simply use this in its place. I had some problems using Set ws before but these are resolved now. See the answer I posted. — Cassiopeia, Nov 28 '14 at 12:29

score 0 · Answer 1 · answered Nov 28 '14 at 12:10

0

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)

answered Nov 28 '14 at 12:10

Rory

32,730
5
32
35

Using `Set` gives "Run-time error 1004; method 'cells' of object'_Global' failed. Could this all be a result of the code being triggered from outlook? – Cassiopeia Nov 28 '14 at 12:19

score 0 · Answer 2 · edited Nov 28 '14 at 12:41

@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

`Dim wb as workbook` and then `Set wb = xlObj.Workbooks.Add`. Finally change `Set ws = Sheets("Sheet1")` to `Set ws = wb.Sheets("Sheet1")` — Siddharth Rout, Nov 28 '14 at 12:33
You can also use @Rory's way but you need to change `Set pasteRange = ActiveSheet.Range(Cells(1, 1), Cells(lastRow, 1))` to `Set pasteRange = ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(lastRow, 1))` :) — Siddharth Rout, Nov 28 '14 at 12:34
I have updated your answer. No point in me pasting a separate answer... Check it out. If that works then delete your code above my code :) — Siddharth Rout, Nov 28 '14 at 12:42
It seems that your code is incompatible with `sub splitAtColons()` which uses the `cells(1,1) method`, which cannot be called from outlook VBA? — Cassiopeia, Dec 09 '14 at 10:05

Problems defining excel range to paste array into from outlook

2 Answers2