獲取發件人的 SMTP email 地址 Excel VBA

Question

我使用以下代碼提取主題、接收日期和發件人姓名：

Set InboxSelect = GetObject("", "Outlook.Application").GetNamespace("MAPI").PickFolder
i = 0: EmailCount = 0
EmailCount = InboxSelect.Items.Count
While i < EmailCount
    i = i + 1
    blastRow = Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
    LastRow = Sheets("Body").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
    With InboxSelect.Items(i)
        MsgBox (SenderEmailAddress)
        'If .senderemailaddress = "*@somethingSpecific.co.uk" Then
            'EmailCount = EmailCount + 1
            Sheets("Import Data").Range("A" & blastRow).Formula = .SenderName
            Sheets("Import Data").Range("B" & blastRow).Formula = Format(.ReceivedTime, "dd/mm/yyyy")
            Sheets("Import Data").Range("C" & blastRow).Formula = .Subject
            Sheets("Body").Range("A" & LastRow).Formula = .Body
        'End If
    End With
Wend

我現在想要實現的是一個 if 語句，它會說“如果發件人的 email 地址是 'anything@somethingSpecific.co.uk' 然后執行該代碼。我已經嘗試過 SenderEmailAddress 但它在消息中測試時返回空白盒子。

編輯： /O=*SET1*/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=*VARIABLE1*現在每次使用以下代碼立即返回 window：

Set InboxSelect = GetObject("", "Outlook.Application").GetNamespace("MAPI").PickFolder
i = 0: EmailCount = 0
EmailCount = InboxSelect.Items.Count
While i < EmailCount
    For Each Item In InboxSelect.Items
        Debug.Print Item.senderemailaddress
        If Item.senderemailaddress = "/O=SET1/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=*" Then
            i = i + 1
            blastRow = Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
            LastRow = Sheets("Body").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
            With InboxSelect.Items(i)
                    Sheets("Import Data").Range("A" & blastRow).Formula = .SenderName
                    Sheets("Import Data").Range("B" & blastRow).Formula = Format(.ReceivedTime, "dd/mm/yyyy")
                    Sheets("Import Data").Range("C" & blastRow).Formula = .Subject
                    'PASTING BODY IS SLOW
                    Sheets("Body").Range("A" & LastRow).Formula = .Body
                'End If
            End With
        End If
    Next Item
Wend

我試圖做的是使用通配符 (*) 作為返回消息的變體，但這沒有用，有沒有更好的方法來做到這一點？

Answer 1

Public Function GetSenderAddrStr(objMail As Outlook.MailItem) As String
 If objMail.SenderEmailType = "SMTP" Then
        GetSenderAddrStr = objMail.SenderEmailAddress
 Else
        GetSenderAddrStr = objMail.Sender.GetExchangeUser().PrimarySmtpAddress
 End If
End Function

Answer 2

使用SenderEmailAddress屬性時的示例將根據需要返回電子郵件字符串。

Dim outlookApp As outlook.Application, oOutlook As Object
Dim oInbox As outlook.Folder, oMail As outlook.MailItem

Set outlookApp = New outlook.Application
Set oOutlook = outlookApp.GetNamespace("MAPI")
Set oInbox = oOutlook.GetDefaultFolder(olFolderInbox)

For Each oMail In oInbox.Items
    Debug.Print oMail.SenderEmailAddress
Next oMail

編輯：

問題是.SenderEmailAddress屬性返回EX地址，而我們想要SMTP地址。 對於任何內部電子郵件地址，它將返回EX類型地址。

要從內部電子郵件獲取SMTP地址，您可以使用以下內容。

Dim outlookApp As Outlook.Application, oOutlook As Object
Dim oInbox As Outlook.Folder, oMail As Outlook.MailItem

Dim strAddress As String, strEntryId As String, getSmtpMailAddress As String
Dim objAddressentry As Outlook.AddressEntry, objExchangeUser As Outlook.ExchangeUser
Dim objReply As Outlook.MailItem, objRecipient As Outlook.Recipient

Set outlookApp = New Outlook.Application
Set oOutlook = outlookApp.GetNamespace("MAPI")
Set oInbox = oOutlook.GetDefaultFolder(olFolderInbox)

For Each oMail In oInbox.Items
    If oMail.SenderEmailType = "SMTP" Then

        strAddress = oMail.SenderEmailAddress

    Else

        Set objReply = oMail.Reply()
        Set objRecipient = objReply.Recipients.Item(1)

        strEntryId = objRecipient.EntryID

        objReply.Close OlInspectorClose.olDiscard

        strEntryId = objRecipient.EntryID

        Set objAddressentry = oOutlook.GetAddressEntryFromID(strEntryId)
        Set objExchangeUser = objAddressentry.GetExchangeUser()

        strAddress = objExchangeUser.PrimarySmtpAddress()

    End If

    getSmtpMailAddress = strAddress
    Debug.Print getSmtpMailAddress

Next oMail

如果電子郵件已經是SMTP ，則只使用.SenderEmailAddress屬性返回地址。 如果電子郵件是EX則它將使用.GetAddressEntryFromID()方法找到SMTP地址。

以上是我在這個答案中找到的修改代碼。 這里還有一個如何在C＃中執行此操作的鏈接。

Answer 3

在大多數情況下，發件人的SMTP地址將在單獨的屬性中可用，您可以使用MailItem.PropertyAccessor訪問它 - 使用OutlookSpy查看現有郵件（單擊IMessage按鈕）。

否則，您可以使用ExchangeUser.PrimarySmtpAddress

脫離我的頭頂：

on error resume next 'PropertyAccessor can raise an exception if a property is not found
if item.SenderEmailType = "SMTP" Then
  strAddress = item.SenderEmailAddress
Else
  'read PidTagSenderSmtpAddress
  strAddress  = item.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x5D01001F")
  if Len(strAddress) = 0 Then
    set objSender = item.Sender
    if not (objSender Is Nothing) Then
      'read PR_SMTP_ADDRESS_W 
      strAddress  = objSender.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x39FE001F")
      if Len(strAddress) = 0 Then
        'last resort
        set exUser = objSender.GetExchangeUser
        if not (exUser Is Nothing) Then
          strAddress = exUser.PrimarySmtpAddress
        End If
      End If
    End If
  En If
End If

Answer 4

你不能只使用發送鍵強制Outlook中的“Control + k”嗎？ 似乎這樣可以解決您的問題，並可能使代碼變得簡單。

嘗試在某處添加這個？

 Application.SendKeys("^k")       'i believe this is correct syntax, never used this yet but i think it works

Answer 5

我最終做了varTest = Item.senderemailaddress If InStr(varTest, "BE WISER INSURANCE") > 0 Then檢測到設置部分不會出現在我不想要的任何電子郵件中。 非常感謝你的幫助，@ Iturner！

Answer 6

在大多數情況下，發件人的 SMTP 地址將在消息本身的單獨屬性中可用（ PidTagSenderSmtpAddress = 0x5D01001F ，DASL 名稱"http://schemas.microsoft.com/mapi/proptag/0x5D01001F" ），您可以使用MailItem.PropertyAccessor - 使用OutlookSpy查看現有郵件（我是其作者） - 單擊 IMessage 按鈕。

否則，您可以使用ExchangeUser.PrimarySmtpAddress ：它比讀取PidTagSenderSmtpAddress屬性更昂貴。 如果ExchangeUser失敗， PidTagSenderSmtpAddress也將起作用（如果用戶已從 GAL 中刪除，或者如果您在與創建消息的配置文件不同的配置文件中查看消息，則可能會發生這種情況）

在我的頭頂上：

on error resume next 'PropertyAccessor can raise an exception if a property is not found
if item.SenderEmailType = "SMTP" Then
  strAddress = item.SenderEmailAddress
Else
  'read PidTagSenderSmtpAddress
  strAddress  = item.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x5D01001F")
  if Len(strAddress) = 0 Then
    set objSender = item.Sender
    if not (objSender Is Nothing) Then
      'read PR_SMTP_ADDRESS_W 
      strAddress  = objSender.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x39FE001F")
      if Len(strAddress) = 0 Then
        'last resort
        set exUser = objSender.GetExchangeUser
        if not (exUser Is Nothing) Then
          strAddress = exUser.PrimarySmtpAddress
        End If
      End If
    End If
  En If
End If