Extracting data from outlook inbox folder into excel

I have an excel file called Customer. Within it, it has column "Name" (Column A) and column "Email" (Column D). Column "Email" is currently empty.

I would like to fill the "Email" Column by matching the name in Column A with name in Outlook inbox folder. When the name match, search for the email address for that name, copy and paste it back to the Customer Sheet Email Column (Column D). Would it be possible to do so with vba?

I tried the following code but it's been running for 4 hours now, I am not sure it is working correctly.

Sub FillEmails()
    Dim customerSheet As Worksheet
    Dim customerLastRow As Long
    Dim customerName As String
    Dim customerEmail As String
    Dim olApp As Object
    Dim olNamespace As Object
    Dim olFolder As Object
    Dim olItems As Object
    Dim olItem As Object
    Dim i As Long

    Set customerSheet = ThisWorkbook.Sheets("Customer")
    
    ' Create an instance of the Outlook application and get the namespace and folder objects
    Set olApp = CreateObject("Outlook.Application")
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olFolder = olNamespace.GetDefaultFolder(6) ' olFolderInbox
    Set olItems = olFolder.Items

    customerLastRow = customerSheet.Cells(Rows.Count, "A").End(xlUp).Row

    For i = 2 To customerLastRow
        customerName = customerSheet.Cells(i, "A").Value
        customerEmail = ""

        ' Search for an email with a matching sender name in the default Inbox folder
        For Each olItem In olItems
            If olItem.Class = 43 Then ' olMail
                If olItem.SenderName = customerName Then
                    customerEmail = olItem.SenderEmailAddress
                    Exit For
                End If
            End If
        Next

        customerSheet.Cells(i, "D").Value = customerEmail
    Next i
    
    ' Clean up the Outlook objects
    Set olItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
End Sub

First of all, iterating over all items in the folder is not really a good idea:

For i = 2 To customerLastRow
        customerName = customerSheet.Cells(i, "A").Value
        customerEmail = ""

        ' Search for an email with a matching sender name in the default Inbox folder
        For Each olItem In olItems
            If olItem.Class = 43 Then ' olMail
                If olItem.SenderName = customerName Then
                    customerEmail = olItem.SenderEmailAddress
                    Exit For
                End If
            End If
        Next

        customerSheet.Cells(i, "D").Value = customerEmail
    Next i

Instead, you need to use the Find/FindNext or Restrict methods of the Items class. They allow getting items that correspond to the specified search criteria, so you don't need to iterate over all items in the folder. Read more about these methods in the articles that I wrote for the technical blog:

• How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
• How To: Use Restrict method to retrieve Outlook mail items from a folder

DASL supports the matching of prefixes, phrases, and substrings in a string property using content indexer keywords ci_startswith and ci_phrasematch, and the keyword like. So, you may try to find a keyword in the following way:

criteria = "@SQL=" & Chr(34) _ 
& "urn:schemas:httpmail:sendername" & Chr(34) _ 
& " ci_phrasematch 'sender_name'" 

The sendername property returns the display name of the message sender. This field corresponds to the RFC 822 Sender: header for a message.

Second, you may try using the NameSpace.CreateRecipient method which creates a Recipient object. It accepts the name of the recipient; it can be a string representing the display name, the alias, or the full SMTP email address of the recipient. So, after resolving the recipient against the address book you may try to get the email address (see the corresponding property).

The Recipient.Resolve method attempts to resolve a Recipient object against the Address Book. The Recipient.Resolved property returns a boolean that indicates true if the recipient has been validated against the Address Book, for example:

Sub ResolveName() 
 Dim myNamespace As Outlook.NameSpace 
 Dim myRecipient As Outlook.Recipient 
 Dim CalendarFolder As Outlook.Folder 
 Set myNamespace = Application.GetNamespace("MAPI") 
 Set myRecipient = myNamespace.CreateRecipient("Eugene Astafiev") 
 
 myRecipient.Resolve 
 
 If myRecipient.Resolved Then 
   MsgBox myRecipient.Address 
 End If 
 
End Sub