使用 Excel VBA 获取发件人的电子邮件地址 [英] Get sender's email address with Excel VBA
问题描述
我使用以下代码提取主题、接收日期和发件人姓名:
I pull the Subject, received date and sender's name with the following code:
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 语句,它会说如果发件人的电子邮件地址是 'anything@somethingSpecific.co.uk' 然后执行该代码.我试过 SenderEmailAddress,但在消息框中测试时返回空白.
What I'm trying to achieve now is an if statement that will say "If the sender's email address is 'anything@somethingSpecific.co.uk' then execute that code. I've tried SenderEmailAddress but it returns blank when tested in a message box.
/O=*SET1*/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=*VARIABLE1*
现在每次都在即时窗口中返回,代码如下:
/O=*SET1*/OU=FIRST ADMINISTRATIVE GROUP/CN=RECIPIENTS/CN=*VARIABLE1*
is now being returned in the immediate window every time with the below code:
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
我试图做的是使用通配符(*)作为返回消息中的变体,但没有奏效,有没有更好的方法来做到这一点?
What I've attempted to do is use a wildcard symbol (the *) to act as the variation in the returned message but that hasn't worked, is there a better way to do this?
推荐答案
使用 SenderEmailAddress
属性返回所需的电子邮件字符串的示例.
An example of when using the SenderEmailAddress
property returns the e-mail string as required.
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
类型的地址.
The issue is that what the .SenderEmailAddress
property is returning the EX
address, whereas we want the SMTP
address. For any internal e-mail addresses, it will return the EX
type address.
要从内部电子邮件中获取 SMTP
地址,您可以使用以下方法.
To get the SMTP
address from an internal e-mail, you can use the below.
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
地址.
If the e-mail is already SMTP
it will just use the .SenderEmailAddress property to return the address. If the e-mail is EX
then it will find the SMTP
address by using the .GetAddressEntryFromID()
Method.
以上是我在 这个答案.这里也是一个链接以及如何在 C# 中执行此操作.
The above is modified code from what I found on this answer. Here is also a link with how to do this within C#.
这篇关于使用 Excel VBA 获取发件人的电子邮件地址的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!