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

-

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

Option Explicit

' VBA Script that gets info on the currently selected email using 'Property Tag Syntax'
' (see other scripts a http://www.GregThatcher.com for other ways to get email properties)
' Property Tag Syntax is used for Outlook Properties (defined by Outlook Object Model)
' as opposed to Named Mapi Properties (defined by Outlook, but only exist if Outlook has added that property to the item of interest)
' or UserProperties (visible to users, and can be added dynamically to an item) or Named Properties (not visible users, can be added dynamically)
' Use Tools->Macro->Security to allow Macros to run, then restart Outlook
' Run Outlook, Press Alt+F11 to open VBA
' Programming by Greg Thatcher, http://www.GregThatcher.com
' THIS SCRIPT WILL ONLY RUN ON OUTLOOK 2007 OR LATER (it won't work on Outlook 2003)

' Types of Properties
Const PT_BOOLEAN As String = "000B"
Const PT_BINARY As String = "0102"
Const PT_MV_BINARY As String = "1102"
Const PT_DOUBLE As String = "0005"
Const PT_LONG As String = "0003"
Const PT_OBJECT As String = "000D"
Const PT_STRING8 As String = "001E"
Const PT_MV_STRING8 As String = "101E"
Const PT_SYSTIME As String = "0040"
Const PT_UNICODE As String = "001F"
Const PT_MV_UNICODE As String = "101F"

Public Sub GetCurrentMailInfoUsingPropertyTagSyntax()
    Dim Session As Outlook.NameSpace
    Dim currentExplorer As Explorer
    Dim Selection As Selection
    Dim currentItem As Object
    Dim currentMail As MailItem
    Dim report As String
    Dim propertyAccessor As Outlook.PropertyAccessor
    
    Set currentExplorer = Application.ActiveExplorer
    Set Selection = currentExplorer.Selection
    
    'for all items do...
    For Each currentItem In Selection
        If currentItem.Class = olMail Then
            Set currentMail = currentItem
            
            Set propertyAccessor = currentMail.PropertyAccessor
    
            report = report & AddToReportIfNotBlank("PR_MESSAGE_CLASS", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x001A" & PT_STRING8)) & vbCrLf
    
            report = report & AddToReportIfNotBlank("PR_SUBJECT", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0037" & PT_STRING8)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_CLIENT_SUBMIT_TIME", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0039" & PT_SYSTIME)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_SENT_REPRESENTING_SEARCH_KEY", propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x003B" & PT_BINARY))) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_SUBJECT_PREFIX PT_STRING8", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x003D" & PT_STRING8)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_RECEIVED_BY_ENTRYID", propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x003F" & PT_BINARY))) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_RECEIVED_BY_NAME", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0040" & PT_STRING8)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_SENT_REPRESENTING_ENTRYID", propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0041" & PT_BINARY))) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_SENT_REPRESENTING_NAME", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0042" & PT_STRING8)) & vbCrLf
            'report = report & AddToReportIfNotBlank("PR_REPLY_RECIPIENT_ENTRIES", propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x004F" & PT_BINARY))) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_REPLY_RECIPIENT_NAMES", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0050" & PT_STRING8)) & vbCrLf
    
            report = report & AddToReportIfNotBlank("PR_RECEIVED_BY_SEARCH_KEY", propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0051" & PT_BINARY))) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_SENT_REPRESENTING_ADDRTYPE", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0064" & PT_STRING8)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_SENT_REPRESENTING_EMAIL_ADDRESS", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0065" & PT_STRING8)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_CONVERSATION_TOPIC", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0070" & PT_STRING8)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_CONVERSATION_INDEX", propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0071" & PT_BINARY))) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_RECEIVED_BY_ADDRTYPE", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0075" & PT_STRING8)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_RECEIVED_BY_EMAIL_ADDRESS", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0076" & PT_STRING8)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_TRANSPORT_MESSAGE_HEADERS", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x007D" & PT_STRING8)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_SENDER_ENTRYID", propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0C19" & PT_BINARY))) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_SENDER_NAME", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0C1A" & PT_STRING8)) & vbCrLf
    
            report = report & AddToReportIfNotBlank("PR_SENDER_SEARCH_KEY", propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0C1D" & PT_BINARY))) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_SENDER_ADDRTYPE", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0C1E" & PT_STRING8)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_SENDER_EMAIL_ADDRESS", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0C1F" & PT_STRING8)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_DISPLAY_BCC", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E02" & PT_STRING8)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_DISPLAY_CC", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E03" & PT_STRING8)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_DISPLAY_TO", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E04" & PT_STRING8)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_MESSAGE_DELIVERY_TIME", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E06" & PT_SYSTIME)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_MESSAGE_FLAGS", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E07" & PT_LONG)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_MESSAGE_SIZE", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E08" & PT_LONG)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_PARENT_ENTRYID", propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E09" & PT_BINARY))) & vbCrLf
    
            'report = report & AddToReportIfNotBlank("PR_MESSAGE_RECIPIENTS", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E12" & PT_OBJECT)) & vbCrLf
            'report = report & AddToReportIfNotBlank("PR_MESSAGE_ATTACHMENTS", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E13" & PT_OBJECT)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_HASATTACH", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E1B" & PT_BOOLEAN)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_NORMALIZED_SUBJECT", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E1D" & PT_STRING8)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_RTF_IN_SYNC", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E1F" & PT_BOOLEAN)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_PRIMARY_SEND_ACCT", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E28" & PT_STRING8)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_NEXT_SEND_ACCT", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E29" & PT_STRING8)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_ACCESS", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0FF4" & PT_LONG)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_ACCESS_LEVEL", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0FF7" & PT_LONG)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_MAPPING_SIGNATURE", propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0FF8" & PT_BINARY))) & vbCrLf
    
            report = report & AddToReportIfNotBlank("PR_RECORD_KEY", propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0FF9" & PT_BINARY))) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_STORE_RECORD_KEY", propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0FFA" & PT_BINARY))) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_STORE_ENTRYID", propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0FFB" & PT_BINARY))) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_OBJECT_TYPE", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0FFE" & PT_LONG)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_ENTRYID", propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0FFF" & PT_BINARY))) & vbCrLf
            'report = report & AddToReportIfNotBlank("PR_BODY", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x1000" & PT_STRING8)) & vbCrLf
            'report = report & AddToReportIfNotBlank("PR_RTF_COMPRESSED", propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x1009" & PT_BINARY))) & vbCrLf
            'report = report & AddToReportIfNotBlank("PR_HTML", propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x1013" & PT_BINARY))) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_INTERNET_MESSAGE_ID", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x1035" & PT_STRING8)) & vbCrLf
            'report = report & AddToReportIfNotBlank("PR_LIST_UNSUBSCRIBE", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x1045" & PT_STRING8)) & vbCrLf
    
            'report = report & AddToReportIfNotBlank("N/A", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x1046" & PT_STRING8)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_CREATION_TIME", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3007" & PT_SYSTIME)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_LAST_MODIFICATION_TIME", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3008" & PT_SYSTIME)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_SEARCH_KEY", propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x300B" & PT_BINARY))) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_STORE_SUPPORT_MASK", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x340D" & PT_LONG)) & vbCrLf
            report = report & AddToReportIfNotBlank("N/A", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x340F" & PT_LONG)) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_MDB_PROVIDER", propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3414" & PT_BINARY))) & vbCrLf
            report = report & AddToReportIfNotBlank("PR_INTERNET_CPID", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3FDE" & PT_LONG)) & vbCrLf
            'report = report & AddToReportIfNotBlank("SideEffects", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x8005" & PT_LONG)) & vbCrLf
            'report = report & AddToReportIfNotBlank("InetAcctID", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x802A" & PT_STRING8)) & vbCrLf
            'report = report & AddToReportIfNotBlank("InetAcctName", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x804F" & PT_STRING8)) & vbCrLf
            'report = report & AddToReportIfNotBlank("RemoteEID", propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x8066" & PT_BINARY))) & vbCrLf
            'report = report & AddToReportIfNotBlank("x-rcpt-to", propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x80AD" & PT_STRING8)) & vbCrLf

            
        End If
    Next
    
    Call CreateReportAsEmail("Email properties from PropertyAccessor using Property Tag Syntax", report)
End Sub


Private Function AddToReportIfNotBlank(FieldName As String, FieldValue As String)
    AddToReportIfNotBlank = ""
    If (FieldValue <> "") Then
        AddToReportIfNotBlank = FieldName & " : " & FieldValue & vbCrLf
    End If
    
End Function

' VBA SubRoutine which displays a report inside an email
' Programming by Greg Thatcher, http://www.GregThatcher.com
Public Sub CreateReportAsEmail(Title As String, report As String)
    On Error GoTo On_Error

    Dim Session As Outlook.NameSpace
    Dim mail As MailItem
    Dim MyAddress As AddressEntry
    Dim Inbox

    Set Session = Application.Session
    Set Inbox = Session.GetDefaultFolder(olFolderInbox)
    Set mail = Inbox.Items.Add("IPM.Mail")

    mail.Subject = Title
    mail.Body = report

    mail.Save
    mail.Display
    

Exiting:
        Set Session = Nothing
        Exit Sub

On_Error:
    MsgBox "error=" & Err.Number & " " & Err.Description
    Resume Exiting

End Sub


[in http://www.gregthatcher.com/Scripts/VBA/Outlook/GetEmailInfoUsingPropertyTagSyntax.aspx]

Comments

Post a Comment

Popular posts from this blog

Keyboard Shortcut to "Toggle Line Comments" in DBeaver

-
Image
In DBeaver, "Ctrl+/" is the default shortcut to Toggle Line Comments. However, in keyboards without a dedicated / key, this may not work out of the box. In my case, the / is obtained with "Shift+7", which means I'd need to set "Ctrl+Shit+7" as the shortcut,  which DBeaver uses by default as the shortcut to "Activate results/panel": So, to set enable the Toggle Line Comments, I needed to remove the "Activate results/panel" configuration from the Preferences and I'm now able to use "Ctrl+Shit+7" for the Toggle Line Comments.
Read more

DBeaver Shortcuts

-
From  DBeaver 6.0 Shortcuts - Cacher Snippet   CTRL + ENTER = Executes SQL. CTRL + ALT + ENTER = In Editor, inits statement templates ALT + X = Executes All queries in current editor CTRL + ALT + SHIFT + X = Execute a script opening each query results in a separate tab CTRL + ] = New SQL Editor Windows CTRL + SHIFT + F = Format SQL CTRL + 9 = Set active connection CTRL + 0 = Set active Schema CTRL + 6 = Toggle Results Panel CTRL + SHIFT + 6 = Maximize Results Panel Tab (when a datarow is selected) = Toggle vertical view CTRL + Alt + Right/Left (When in vertical view) = Browse rows CTRL + SPACE = To perform some object name auto-complete F4 = To open current object (under cursor) definition From  Shortcuts · dbeaver/dbeaver Wiki · GitHub Here is a complete list of default hotkeys in DBeaver UI for Windows, Linux, and macOS users. It will help you work in DBeaver faster and more efficiently. Remember that you can always change the keyboard shortcut in the DBeaver settings. ...
Read more

Add GitHub Repository to DBeaver CE Secured with SSH Protocol

-
Image
  From  Add GitHub Repository to DBeaver CE Secured with SSH Protocol - tech jogging Add GitHub Repository to DBeaver CE Secured with SSH Protocol Date  2021-06-14 Views 2579 Category DBeaver ,  Git GitHub is a good addition to DBeaver Community Edition (CE). It allows to store scripts and other files in source control. Even with some limitations in DBeaver CE, GitHub full functionality can be utilized. There are varieties of ways connecting GitHub to DBeaver CE. SSH protocol provides with enhanced security and seamlessly integrated with DBeaver CE. In some cases, it can work when HTTPS one might be problematic. The article uses DBeaver 21.1.0 CE installed in Windows. 1. Prerequisite. Create SSH key Follow  Create SSH Key in DBeaver CE  article. 2. Prerequisite. Install DBeaver Git extension Follow  Install DBeaver CE Git Extension  article. 3. Open File menu and select Import menu item 4. Expand Git node and select any item, for example, Projects...
Read more