我有一个名为Customer的Excel文件。在其中，它具有列“名称”（列A）和列“电子邮件”（列D）。“电子邮件”栏当前为空。
我想通过匹配Outlook收件箱文件夹中A列中的名称来填充“电子邮件”列。当名称匹配时，搜索该名称的电子邮件地址，将其复制并粘贴回客户工作表电子邮件列（D列）。vba可以做到这一点吗？
我尝试了下面的代码，但它已经运行了4个小时了，我不确定它是否正常工作。

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