SenderEmailAddress在VBA代碼在Excel

Question

給予路徑

我設計了一個VBA代碼使用鏈接Retrieve maillist from outlook

下面有一行代碼來檢索您的Outlook收件箱郵件列表

ThisWorkbook.Sheets(1).Cells(oRow, 5) = Folder.Items.Item(iRow).SenderEmailAddress 

指定讓發件人電子郵件地址，但，當它被存儲在Excel中它會顯示如下

/O=EXCHANGELABS/OU=EXCHANGE ADMINISTRATIVE GROUP (FYDIBOHF23SPDLT)/CN=RECIPIENTS/CN=WIPRO365.ONMICROSOFT.COM-52823-C1374FA5 

我想看看它ķ nowledge@wipro.com的意思是說用正確的電子郵件格式。如何利用這個選項？我應該在VBA代碼還是excel中進行更改。

我已經在很多博客中嘗試過這種方法，但仍然徒勞無功。任何建議都會有所幫助。

Answer 1

首先，這是多點符號採取極端 - Folder.Items.Item(iRow)。這是一個非常糟糕的主意，特別是在循環中 - 每個「。」。強制Outlook創建並返回一個全新的COM對象。在進入循環之前緩存Folder.Items，並且在循環的開始處僅使用Items.Item（I）檢索MailItem一次。

這就是說，你得到的是一個完全有效的EX類型的地址。首先檢查MailItem.SenderEmailType屬性。如果它是「EX」，請使用MailItem.Sender.GetExchangeUser.PrimarySmtpAddress（準備處理空值）。否則，只需使用MailItem.SenderEmailAddress屬性。

Answer 2

看一看這裏如何看待全球通訊簿 Outlook 2010 GAL with Excel VBA

這裏是一個非常簡單的實現一個轉換爲SMTP地址爲Exchange帳戶。

Option Explicit 
Dim appOL As Object 
Dim oGAL As Object 
Dim i 
Dim oContact 
Dim oUser 
Dim UserIndex 
Dim arrUsers(1 To 65000, 2) As String 

Sub test() 

End Sub 
Sub Download_Outlook_Mail_To_Excel() 
'Add Tools->References->"Microsoft Outlook nn.n Object Library" 
'nn.n varies as per our Outlook Installation 
Dim folders As Outlook.folders 
Dim folder As Outlook.MAPIFolder 
Dim iRow As Integer 
Dim Pst_Folder_Name 
Dim MailboxName 

Set appOL = CreateObject("Outlook.Application") 


'Mailbox or PST Main Folder Name (As how it is displayed in your Outlook Session) 
MailboxName = "your email address" 

'Mailbox Folder or PST Folder Name (As how it is displayed in your Outlook Session) 
Pst_Folder_Name = "Inbox" 

Set folder = Outlook.Session.folders(MailboxName).folders(Pst_Folder_Name) 
If folder = "" Then 
    MsgBox "Invalid Data in Input" 
    GoTo end_lbl1: 
End If 

'Rad Through each Mail and export the details to Excel for Email Archival 
Sheets(1).Activate 
Dim mail As Outlook.MailItem 
Dim oAccount As Outlook.Account 
Dim stringAddress 
FillAddress 

For iRow = 1 To folder.Items.Count 
    If folder.Items.Item(iRow).Class = olMail Then 
     Set mail = folder.Items.Item(iRow) 
     Sheets(1).Cells(iRow, 1).Select 
     Sheets(1).Cells(iRow, 1) = mail.SenderName 
     Sheets(1).Cells(iRow, 2) = mail.Subject 
     Sheets(1).Cells(iRow, 3) = mail.ReceivedTime 
     Sheets(1).Cells(iRow, 4) = mail.Size 

     Select Case mail.SenderEmailType 
     Case "SMTP" 
      Sheets(1).Cells(iRow, 5) = mail.SenderEmailAddress 
     Case "EX" 
      'Set oAccount = Outlook. 
      stringAddress = FindAddress(mail.SenderEmailAddress) 
      Sheets(1).Cells(iRow, 5) = stringAddress 
     End Select 
    End If 
    'Set oAccount = mail.SenderEmailAddress 
    'Sheets(1).Cells(iRow, 6) = Folder.Items.Item(iRow).Body 
Next iRow 
MsgBox "Outlook Mails Extracted to Excel" 

end_lbl1: 

End Sub 

Function FindAddress(strAddress) 
Dim address As String 
For i = 1 To 65000 
    If UCase(arrUsers(i, 0)) = strAddress Then 
     address = arrUsers(i, 2) 
     Exit For 
    End If 
Next 
FindAddress = address 
End Function 

Sub FillAddress() 
    Set oGAL = appOL.GetNamespace("MAPI").AddressLists("Global Address List").AddressEntries 
    For i = 1 To oGAL.Count 
     Set oContact = oGAL.Item(i) 
     If oContact.AddressEntryUserType = 0 Then 
      Set oUser = oContact.GetExchangeUser 
      If Len(oUser.LastName) > 0 Then 
       UserIndex = UserIndex + 1 
       arrUsers(UserIndex, 0) = oUser.address 
       arrUsers(UserIndex, 1) = oUser.Name 
       arrUsers(UserIndex, 2) = oUser.PrimarySmtpAddress 
      End If 
     End If 
    Next i 
End Sub