Retrieving Outlook email data using Excel VBA

Question

I am trying to grab the following details from the sent items folder with subject "Index Coverage".

Sent by
Sent to
Subject
Sent on (date)
email body

I am using formulas in the sheet with code in the ThisOutlookSession module

Index: =TRIM(MID(G2,SEARCH("Code",G2)+(8+LEN("Code")),20))

Our client: =LEFT(I2,FIND("on",I2)-1)

End client: =LEFT(K2,FIND(".",K2)-1)

Const strFilePath As String = "C:\Users\Public\Documents\Excel\OutlookMailItemsDB.xlsx"
Const strSubjectLineStartWith As String = ""
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
   
    Dim varArray As Variant
    Dim strSub As String
    Dim strBody As String
    Dim strArray() As String
    Dim lngLoop As Long
    Dim objItem As Object
    Dim lngMailCounter As Long
    Dim objMItem As MailItem
    strArray = Split(EntryIDCollection, ",")
    For lngMailCounter = LBound(strArray) To UBound(strArray)
        Set objItem = Session.GetItemFromID(strArray(lngMailCounter))
        If TypeName(objItem) = "MailItem" And InStr(1, objItem.Subject, strSubjectLineStartWith) And InStr(1, objItem.Body, "") Then
            Set objMItem = objItem
            With CreateObject("Excel.Application").workbooks.Open(strFilePath)
                With .sheets(1)
                    With .cells(.rows.Count, 1).End(-4162)(2).resize(1, 7)
                        .Value = Array(objMItem.SenderEmailAddress, objMItem.To, objMItem.CC, objMItem.BCC, objMItem.Subject, objMItem.ReceivedTime, objMItem.Body)
                    End With
                End With
                .Close 1
            End With
            Set objItem = Nothing
        End If
    Next lngMailCounter
    If Not IsEmpty(strArray) Then
        Erase strArray
    End If
   
End Sub

I am able to grab:
sent by
subject
sent on
Body
Index
Our client
End client

I am not able to grab the recipient contact details.

Also the Excel sheet placed on the desktop needs to be saved and closed on its own so that next time it doesn't throw an error that Excel is not closed.

Also it should consider the sent items folder with the following subject line: "Index Coverage".

Also to grab the details for Index, Our client and End client I am using Excel formulas. Is it possible to achieve this via VBA?

The image indicates the first two headings should be moved to the left. — niton, Mar 28 '21 at 15:31
First search for similar questions. If no solutions then split the post into separate questions. — niton, Mar 28 '21 at 15:57
Sent by is `objMItem.SenderEmailAddress` is O/EXCHANGE... . Sent To is `objMItem.To` is Mohan. The question mark is `objMItem.CC` — niton, Mar 28 '21 at 19:16
but headings are something that i have put in manually in the sheet — Naina, Mar 28 '21 at 19:39
Pull `CreateObject("Excel.Application")` out of the `With` so you can `.Quit` Excel. Start with this example code https://stackoverflow.com/questions/24374763/excel-application-not-closing-from-outlook-vba-function. — niton, Mar 31 '21 at 13:05

score 0 · Answer 1 · answered Apr 04 '21 at 13:22

First of all, creating a new Excel instance in the NewMailEx event handler each time a new email is received is not really a good idea. I'd suggest keeping a reference when the add-in works (like a singleton) to prevent any additional workload when receiving a new item.

Try to use the Recipients property of the MailItem class instead of using the To, Cc or Bcc fields. The Recipients collection returns a Recipients collection that represents all the recipients for the Outlook item. Use Recipients(index) where index is the name or index number, to return a single Recipient object. The name can be a string representing the display name, the alias, or the full SMTP email address of the recipient.

Finally, to process items added to the sent items folder you need to handle ItemAdd event which is fired when one or more items are added to the specified collection.

Public WithEvents myOlItems As Outlook.Items 

Public Sub Initialize_handler() 
 Set myOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentItems).Items 
 
End Sub 

Private Sub myOlItems_ItemAdd(ByVal Item As Object) 
  ' your code for processing the Item object goes there
End Sub

Retrieving Outlook email data using Excel VBA

1 Answers1