Excel Hints

Results 1 to 8 of 8

Thread: How to get the email address an email was sent to?

  1. #1

    Red face How to get the email address an email was sent to?

    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?

    (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.)

  2. #2
    This should get you started. Paste the following code into a standard module in an Excel workbook VB project:
    VB:
     '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 
    
    
    Formatting tags added by mark007
    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.

  3. #3
    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

  4. #4

  5. #5
    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?

  6. #6
    Try installing the Office Compatibility Pack.

  7. #7
    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!

  8. #8
    Quote Originally Posted by Rob M
    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)

    Outlook VBA Script that gets info on currently selected email using Property Tag Syntax

    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:

    VB:
    report = report & AddToReportIfNotBlank("PR_RECEIVED_BY_EMAIL_ADDRESS", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0076" & PT_STRING8)) & vbCrLf 
    
    
    Formatting tags added by mark007
    which you could adapt for your purposes.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •