使用 Excel VBA 获取发件人的 SMTP 电子邮件地址

Jos*_*eld 4 email excel outlook vba

我使用以下代码提取主题、接收日期和发件人姓名:

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
Run Code Online (Sandbox Code Playgroud)

我现在想要实现的是一个 if 语句,它会说“如果发件人的电子邮件地址是 'anything@somethingSpecific.co.uk',则执行该代码。我已经尝试过 SenderEmailAddress,但在消息中测试时它返回空白盒子。

编辑:/O=*SET1*/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=*VARIABLE1*现在每次都使用以下代码在立即窗口中返回:

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
Run Code Online (Sandbox Code Playgroud)

我尝试做的是使用通配符(*)作为返回消息中的变体,但这没有用,有更好的方法吗?

Fre*_*ers 6

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
Run Code Online (Sandbox Code Playgroud)