VBA – Extract Outlook E-mail Messages

E-mails

Building upon my earlier post VBA – Extract Outlook Contacts in which I helped someone extract contact information, I thought I’d post a very similar procedure that enable one to extract e-mail messages from outlook.

'---------------------------------------------------------------------------------------
' Procedure : Outlook_ExtractMessages
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Extract E-mail Listing
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Usage:
' ~~~~~~
' Call Outlook_ExtractMessages
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2019-07-15              Initial Release
'---------------------------------------------------------------------------------------
Sub Outlook_ExtractMessages()
    Dim oOutlook              As Object    'Outlook.Application
    Dim oNameSpace            As Object    'Outlook.Namespace
    Dim oFolder               As Object    'Outlook.folder
    Dim oItem                 As Object
    Dim oPrp                  As Object
    Const olFolderInbox = 6
    Const olMail = 43

    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")        'Bind to existing instance of Outlook
    If Err.Number <> 0 Then        'Could not get instance, so create a new one
        Err.Clear
        Set oOutlook = CreateObject("Outlook.Application")
    End If
    On Error GoTo Error_Handler

    Set oNameSpace = oOutlook.GetNamespace("MAPI")
    Set oFolder = oNameSpace.GetDefaultFolder(olFolderInbox)
    '    Set oFolder = oOutlook.ActiveExplorer.CurrentFolder    'Process the currently selected folder
    '    Set oFolder = oNameSpace.PickFolder    'Prompt the user to select the folder to process

    On Error Resume Next
    For Each oItem In oFolder.Items
        With oItem
            If .Class = olMail Then
                Debug.Print .EntryId, .Subject, .Sender, .SentOn, .ReceivedTime
                For Each oPrp In .ItemProperties
                    Debug.Print , oPrp.Name, oPrp.Value
                Next oPrp
            End If
        End With
    Next oItem

Error_Handler_Exit:
    On Error Resume Next
    If Not oPrp Is Nothing Then Set oPrp = Nothing
    If Not oItem Is Nothing Then Set oItem = Nothing
    If Not oFolder Is Nothing Then Set oFolder = Nothing
    If Not oNameSpace Is Nothing Then Set oNameSpace = Nothing
    If Not oOutlook Is Nothing Then Set oOutlook = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: Outlook_ExtractMessages" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

In the code above, I provided 3 different way of defining oFolder, so pick the one that best suits your needs.

4 responses on “VBA – Extract Outlook E-mail Messages”

  1. Tom

    Thanks for that Daniel. Much appreciated.
    OK so using your code I can store email properties, contents etc.

    Now I want to be able to instruct Outlook to open one of the emails whose properties I have stored in my Access database. By ‘open’ I mean the equivalent of double-clicking the email in an Outlook folder.

    Using your code ‘ For Each oPrp In .ItemProperties’ I wrote all of the 90 property/value pairs to a table. There are ‘oPrp.Name’s like ConversationIndex, EntryID, ConversationID which I suspect can be used to reference the exact email in Outlook. But how?

    Any help much appreciated.
    Thanks
    Tom

    1. Daniel Pineault Post author

      EntryId is a uniqueIdentifier that you can use to open items. For example you can do something like:

      '---------------------------------------------------------------------------------------
' Procedure : Outlook_OpenEmail
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Locate and open an Item based on its EntryId
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sEntryId - The EntryId to locate
'
' Usage:
' ~~~~~~
' Outlook_OpenEmail "000000004829439D8D28C14BAA8D1C72F0D28EA6E4552500"
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2019-08-19              Initial Release
'---------------------------------------------------------------------------------------
Function Outlook_OpenEmail(ByVal sEntryId As String)
'REF: https://docs.microsoft.com/en-us/office/vba/api/outlook.namespace.getitemfromid
'    #Const EarlyBind = 1 'Use Early Binding
    #Const EarlyBind = 0    'Use Late Binding
    #If EarlyBind Then
        Dim oOutlook          As Outlook.Application
        Dim oOutlookMsg       As Outlook.MailItem
    #Else
        Dim oOutlook          As Object
        Dim oOutlookMsg       As Object
    #End If

    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")        'Bind to existing instance of Outlook
    If Err.Number <> 0 Then        'Could not get instance, so create a new one
        Err.Clear
        Set oOutlook = CreateObject("Outlook.Application")
    End If
    On Error GoTo Error_Handler

    Set oNameSpace = oOutlook.GetNamespace("MAPI")
    Set oOutlookMsg = oNameSpace.GetItemFromID(sEntryId)
    oOutlookMsg.Display

Error_Handler_Exit:
    On Error Resume Next
    If Not oOutlookMsg Is Nothing Then Set oOutlookMsg = Nothing
    If Not oOutlook Is Nothing Then Set oOutlook = Nothing
    Exit Function

Error_Handler:
    If Err.Number = "287" Then
        MsgBox "You clicked No to the Outlook security warning. " & _
               "Rerun the procedure and click Yes to access e-mail " & _
               "addresses to send your message. For more information, " & _
               "see the document at http://www.microsoft.com/office" & _
               "/previous/outlook/downloads/security.asp."
    ElseIf Err.Number = -2147221233 Then
        MsgBox "Item not found", vbInformation + vbOKOnly
    Else
        MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: Outlook_OpenEmail" & vbCrLf & _
               "Error Description: " & Err.Description & _
               Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
               , vbOKOnly + vbCritical, "An Error has Occured!"
    End If
    Resume Error_Handler_Exit
End Function
    1. Daniel Pineault Post author

      My example is simply Debug.Print(ing) it, so displaying it in the VBE immediate window, but you can customize the code to do whatever you’d like with the returned items. The choice is yours at that point.