PDA

View Full Version : How to get the email address an email was sent to?



Rob M
04-04-2012, 09:55 AM
Is there a way, using VBA or otherwise, to get the email address a email was sent to?

I have multiple email addresses that all arrive in the same account, and sometimes I would like to know which address was used.
(This is particularly relevant where I have been BCC'd, but there are other circumstances also.)

Does anyone know a way to do this? :help

(Just to make it more interesting, I would particularly like to do this from Excel, so I can list all emails sent to me using a particular address.
Also, I occasionally get duplicate emails where more than one of my addresses is in the distribution list, so I would like to be able to distinguish which one was sent to which address.)

Crocus Crow
04-06-2012, 06:23 AM
This should get you started. Paste the following code into a standard module in an Excel workbook VB project:
'References Microsoft Outlook 11.0 Object Library and Microsoft CDO 1.21 Library

Option Explicit

Sub CDO_Get_Email_Details()

Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olInbox As Outlook.MAPIFolder
Dim olItem As Object
Dim olMailItem As Outlook.MailItem
Dim ws As Worksheet
Dim row As Long
Dim i As Integer
Dim CDOsession As Session
Dim CDOmessage As Message
Dim CDOmessageFields As Fields
Dim CDOfield As field

Set ws = Worksheets("Sheet1")
With ws
.Cells.ClearContents
.Activate
.Range("A1:F1").Value = Array("Sender", "Received Time", "Subject", "Received by Email Address", "Display To", "Original Display BCC")
End With

row = 2

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olInbox = olNs.GetDefaultFolder(olFolderInbox)

'Set CDOsession = CreateObject("MAPI.Session") 'Late binding
Set CDOsession = New MAPI.Session
CDOsession.Logon "", "", False, False

For Each olItem In olInbox.Items
If olItem.Class = olMail Then
Set olMailItem = olItem
Set CDOmessage = CDOsession.GetMessage(olMailItem.EntryID, olMailItem.Parent.StoreID)
Set CDOmessageFields = CDOmessage.Fields

If HasCDOfield(CDOmessageFields, CdoPropTags.CdoPR_SENDER_EMAIL_ADDRESS) Then
Set CDOfield = CDOmessageFields.Item(CdoPropTags.CdoPR_SENDER_EMAIL_ADDRESS)
ws.Cells(row, "A").Value = CDOfield.Value
End If

If HasCDOfield(CDOmessageFields, CdoPropTags.CdoPR_CREATION_TIME) Then
Set CDOfield = CDOmessageFields.Item(CdoPropTags.CdoPR_CREATION_TIME)
ws.Cells(row, "B").Value = CDOfield.Value
End If

Set CDOfield = CDOmessageFields.Item(CdoPropTags.CdoPR_SUBJECT)
ws.Cells(row, "C").Value = CDOfield.Value

Set CDOfield = CDOmessageFields.Item(CdoPropTags.CdoPR_RECEIVED_BY_EMAIL_ADDRESS)
ws.Cells(row, "D").Value = CDOfield.Value

Set CDOfield = CDOmessageFields.Item(CdoPropTags.CdoPR_DISPLAY_TO)
ws.Cells(row, "E").Value = CDOfield.Value

If HasCDOfield(CDOmessageFields, CdoPropTags.CdoPR_ORIGINAL_DISPLAY_BCC) Then
Set CDOfield = CDOmessageFields.Item(CdoPropTags.CdoPR_ORIGINAL_DISPLAY_BCC)
ws.Cells(row, "F").Value = CDOfield.Value
End If

row = row + 1
End If
Next
End Sub

Private Function HasCDOfield(CDOmessageFields As Fields, CDOproperty As CdoPropTags) As Boolean
Dim i As Integer

HasCDOfield = False
i = 1
While i <= CDOmessageFields.Count And Not HasCDOfield
If CDOmessageFields.Item(i).ID = CDOproperty Then HasCDOfield = True
i = i + 1
Wend

End Function
The code uses early binding so you need the references noted in the comment at the top of the code. Set these via Tools - References in the VBA project.

The message field containing the recipient email address is the CdoPR_RECEIVED_BY_EMAIL_ADDRESS field (column D in the code). In my tests, this contains the recipient email address whether the sender sent the email to that address as the 'To:' address or the 'Bcc:' address. I've added a few more columns/CDO fields such as Sender and Subject to the Excel output to give more details for each email.

Rob M
04-14-2012, 07:39 AM
Thank you for this code - it look likes what I want, but when I tried it I get a compilation error.

I have referenced to Microsoft Outlook 14.0 Object Library and Microsoft CDO for Windows 2000 Library (the only Microsoft CDO in the list, location C:\Windows\SysWOW64\cdosys.dll).

When I try to run the code, it goes to the top line of the function and gives the message "Compile Error: User-defined type not defined". Any ideas?

It does not seem to like the following types: CdoPropTags, Fields, Field or Session

Crocus Crow
04-17-2012, 12:50 PM
The code uses CDO 1.21 (CDO.DLL), which you can download from http://www.microsoft.com/download/en/details.aspx?displaylang=en&id=3671

Rob M
04-21-2012, 01:42 PM
When I try to install this, it says that it cannot be installed unless Microsoft Office Outlook 2007 is also installed.

I have Outlook 2010. Is there anything I can do?

Crocus Crow
04-23-2012, 06:51 AM
Try installing the Office Compatibility Pack.

Rob M
04-23-2012, 01:50 PM
The Compatability Pack is to allow you to use later versions, not earlier versions, isn't it?

I found on the MS website "CDO 1.2.1 is not supported for use with Outlook 2010. Most of the CDO 1.2.1 functionality has been incorporated into the Outlook 2010 object model", but no clue as to how to do this!

Crocus Crow
04-24-2012, 10:05 AM
The Compatability Pack is to allow you to use later versions, not earlier versions, isn't it?Ah yes, I think you are correct.

When I was researching answers to your question 3 weeks ago I came across code on 2 web pages which might work for you. I didn't try them because I have Office 2003 and didn't know you have 2010 at that time. Luckily the 2 pages are still in my browser history:

Outlook VBA Script that gets info on currently selected email using various Property Syntaxes (DASL) (http://www.gregthatcher.com/Scripts/VBA/Outlook/GetEmailInfoUsingPropertyAccessor.aspx)

Outlook VBA Script that gets info on currently selected email using Property Tag Syntax (http://www.gregthatcher.com/Scripts/VBA/Outlook/GetEmailInfoUsingPropertyTagSyntax.aspx)

The key to both scripts is the use of Outlook.PropertyAccessor, which is only available in Outlook 2007 and later, so I can't test it. The line in the 2nd piece of code which is relevant to your question is:

report = report & AddToReportIfNotBlank("PR_RECEIVED_BY_EMAIL_ADDRESS", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0076" & PT_STRING8)) & vbCrLfwhich you could adapt for your purposes.