View Single Post
 
Old 11-24-2015, 11:37 AM
charlesdh charlesdh is offline Windows 7 32bit Office 2010 32bit
Expert
 
Join Date: Apr 2014
Location: Mississippi
Posts: 382
charlesdh is on a distinguished road
Default

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
Reply With Quote