Copy Emails body to Excel issue ("Method 'Rows' of object '_Global' failed")

[steevas]

Hi,

I'm trying to write my first Outlook VBA script and I got stuck. What I need to do is to copy the part of emails' body to excel in separate rows. Code below is working only for the first new email. If I send the second email it crashes on
rFill = xlWks.Cells(Rows.Count, "A").End(xlUp).Row
with error "Method 'Rows' of object '_Global' failed".
Do you have any ideas why? I am not used to work with objects so I think I missed something here. Also I noticed that "excel.exe" is in running proccesses after this though all Excel files are closed so maybe script doesn't close Excel properly?

Please help me. Code is below.

Option Explicit
Private WithEvents olInboxItems As Items

Private Sub Application_Startup()

Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing

End Sub

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)

Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlWks As Excel.Worksheet
Dim xlRng As Excel.Range
Dim bSplit() As String
Dim rDet() As Variant
Dim m As Integer
Dim i As Integer
Dim rFill As Integer

Set xlApp = New Excel.Application
Set xlWkb = xlApp.Workbooks.Open("C:\Users\andrej\Desktop\emails.xlsx")


Set xlWks = xlWkb.Worksheets("Sheet1")
Set xlRng = xlWks.Range("a1")

m = 0
bSplit = Split(Item.Body, vbCrLf)

For i = 0 To UBound(bSplit)
If InStr(bSplit(i), "~") > 0 Then
m = m + 1
End If
Next i

ReDim rDet(1 To m)
m = 0

rFill = xlWks.Cells(Rows.Count, "A").End(xlUp).Row

For i = 0 To UBound(bSplit)
If InStr(bSplit(i), "~") > 0 Then
m = m + 1
rDet(m) = Right(bSplit(i), Len(bSplit(i)) - InStr(bSplit(i), "~") - 1)
xlRng.Offset(rFill, m).Value = rDet(m)
End If
Next i

Item.UnRead = False
xlRng.Offset(rFill, 0).Value = Date

xlApp.Visible = True
xlWkb.Close True

Set xlApp = Nothing
Set xlWkb = Nothing
Set xlWks = Nothing
Set xlRng = Nothing

End Sub

[JP2112]

Rows.Count is a reference to Excel's Rows Object, but you're in Outlook.

Qualify the object with a reference to your Excel worksheet like this:

rFill = xlWks.Cells(xlWks.Rows.Count, "A").End(xlUp).Row
If your script terminates abnormally, and you've instantiated another program, it tends to stick around. If you solve the first problem then the second one should clear up on it's own.