HI,
Here is a code I found that may help. I remarked a area that you can review for your concern.
I can not test it as to I do not have "Outlook".
Code:
Private Sub Application_NewMail()
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim myItem As MailItem
Dim myXLApp As Excel.Application
Dim myXLWB As Excel.Workbook
Dim StrBody As String
Dim TotalRows As Long, i As Long''' here
Set objNS = GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderInbox)
Set myItems = objFolder.Items
'''' Here possible '''''
myItems.Sort "CreationTime", True
Set myItem = myItems.Item(1)
'''''''''''''''''
Set myXLApp = New Excel.Application
myXLApp.Visible = True
Set myXLWB = myXLApp.Workbooks.Open("H:\outlookitems2.xlsx")
TotalRows = myXLWB.Sheets(1).Range("A65536").End(xlUp).Row
i = TotalRows + 1
With myXLWB.Worksheets(1)
.Cells(i, 1) = Format(myItem.SentOn, "mm/dd/yyyy")
.Cells(i, 2) = Format(myItem.SentOn, "h:mm:ss AM/PM")
.Cells(i, 3) = myItem.SenderName
.Cells(i, 4) = myItem.To
.Cells(i, 5) = myItem.Body
End With
With myXLWB
.Save
.Close
End With
With myXLApp
.Quit
End With
End Sub