none
use vba to create note item RRS feed

  • Question

  • Good morning all.

    I'm not sure if my subject line was an accurate description of what I want, so please read the backstory, and I think it'll clear up my goal. 

    My employer has a fairly sophisticated security system to check for phishing emails. 

    So much so that they apparently send out test emails quarterly to test our awareness of the scams. 

    Well, this morning was my turn, and I got burned. I was scared sh88less, thinking I'd really screwed up, and after a few minutes of stewing, and feeling like an idiot, I got a call from the head security guy, and after a bit of back and forth, he informed me that it was a test, and my email was a test mail. 

    Normally, I check the view source window, but this time, it didn't show anything out of the ordinary.... in fact, it was abnormally vacant, missing all the headers, etc... It was then that he informed me that it was moved, and I now have to view properties to see the headers. 

    So..... my goal is that I want to create a menu button for the ribbon-- I suppose an add-on-- that will call up a couple of things.

    1- I want to create a medium sized window with a number of items to remind me what I can do to see if the email in question is a phish/scam/attack. Basically a descriptive list. I can populate the list, I just need to code for how to develop the window/page, and add a command window. 

    2- I want a button on that note window to activate the contents of the properties window so I can see the internet headers, if any. 

    How would I accomplish this? 

    Your help would be really appreciated. 

    We're using Enterprise Office 365, and I'm on Win10Pro. 

    TYIA
    • Edited by SteveDB1 Tuesday, October 29, 2019 4:52 PM added statement.
    Tuesday, October 29, 2019 4:52 PM

Answers

  • Well, it's been two weeks now, and nobody has tried taking this on. 

    I've removed the user form, because something in this code prevents the forms from working. It does however work without the form, and provides my message box as a prelim description/explanation.  So, I've essentially answered this, and it will be marked as such. 

    Have a great day.

    Best.

    Sub EmailHeaders()
    
    'so this code cannot be included in a user form. It must be operated independently.
    
        Dim olItem As Outlook.MailItem, olMsg As Outlook.MailItem       '   ReportItem  ItemProperties
        Dim strheader As String
        MsgBox "Here is a list of things to consider when dealing with Phish attacks:  " & Chr(10) & "1) please stop and consider if you don't recognize the sender, " & Chr(10) _
        & "don't recognize the attachment, or the content is something you're not expecting-- it's probably a phish attempt. " & Chr(10) & "Please stop, and consider. This utility will allow you to check the headers to see if there's some fraud taking place." _
        & Chr(10) & "Examine the headers that are shown in the body of the email, and see if they show abnormal email addresses. "
    & Chr(10) & "This  VB Information box can be populated with your specific message and notes." _
        & Chr(10) & "I picked something real basic just to get it started. It does however work nicely."_
    , vbInformation
    
        For Each olItem In Application.ActiveExplorer.Selection
            strheader = GetInetHeaders(olItem)
        
            Set olMsg = Application.CreateItem(olMailItem)
            With olMsg
                .BodyFormat = olFormatPlain
                .Body = strheader
                .Display '= olMailItem
            End With
        Next
        Set olMsg = Nothing
    End Sub
    
    Function GetInetHeaders(olkMsg As Outlook.MailItem) As String
        ' Purpose: Returns the internet headers of a message.'
        ' Written: 4/28/2009'
        ' Author:  BlueDevilFan'
        ' //techniclee.wordpress.com/
        ' Outlook: 2007'
        Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
        Dim olkPA As Outlook.PropertyAccessor
        Set olkPA = olkMsg.PropertyAccessor
        GetInetHeaders = olkPA.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
        Set olkPA = Nothing
    End Function
    

    • Marked as answer by SteveDB1 Tuesday, November 12, 2019 5:14 PM
    Tuesday, November 12, 2019 5:14 PM

All replies

  • Ok. In doing some searching, I found several pages that show variations on how to accomplish what I'm asking, but this one is throwing an error. 

    Private Sub CommandButton1_Click()
    
        Dim olItem As Outlook.MailItem, olMsg As Outlook.MailItem
        Dim strheader As String
    
        For Each olItem In Application.ActiveExplorer.Selection
            strheader = GetInetHeaders(olItem)
        
            Set olMsg = Application.CreateItem(olMailItem)
            With olMsg
                .BodyFormat = olFormatPlain
                .Body = strheader
                .Display
            End With
        Next
        Set olMsg = Nothing
    End Sub
    
    Function GetInetHeaders(olkMsg As Outlook.MailItem) As String
        ' Purpose: Returns the internet headers of a message.'
        ' Written: 4/28/2009'
        ' Author:  BlueDevilFan'
        ' //techniclee.wordpress.com/
        ' Outlook: 2007'
        Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
        Dim olkPA As Outlook.PropertyAccessor
        Set olkPA = olkMsg.PropertyAccessor
        GetInetHeaders = olkPA.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
        Set olkPA = Nothing
    End Function


    When it gets to .Display in the With operation, the error I receive is the

    "Run-Time error '-2147467259 (80004005):

    Outlook can't do this because a dialog box is open. Please close it and try again."

    The problem is that the only dialog box which is open is the user form, and the outlook program window itself. 

    I have tried closing the form, and continuing to run the macro, but it repeats the error. 

    As an addendum.... that run time error has several variations, depending on the program. So, I have no idea what the problem is, except to say that the error is thrown with the display command in the with operation. 

    2nd addendum

    the code works, but not with a user form. 

    • Edited by SteveDB1 Tuesday, October 29, 2019 8:28 PM added 2nd addendum
    Tuesday, October 29, 2019 5:49 PM
  • Well, it's been two weeks now, and nobody has tried taking this on. 

    I've removed the user form, because something in this code prevents the forms from working. It does however work without the form, and provides my message box as a prelim description/explanation.  So, I've essentially answered this, and it will be marked as such. 

    Have a great day.

    Best.

    Sub EmailHeaders()
    
    'so this code cannot be included in a user form. It must be operated independently.
    
        Dim olItem As Outlook.MailItem, olMsg As Outlook.MailItem       '   ReportItem  ItemProperties
        Dim strheader As String
        MsgBox "Here is a list of things to consider when dealing with Phish attacks:  " & Chr(10) & "1) please stop and consider if you don't recognize the sender, " & Chr(10) _
        & "don't recognize the attachment, or the content is something you're not expecting-- it's probably a phish attempt. " & Chr(10) & "Please stop, and consider. This utility will allow you to check the headers to see if there's some fraud taking place." _
        & Chr(10) & "Examine the headers that are shown in the body of the email, and see if they show abnormal email addresses. "
    & Chr(10) & "This  VB Information box can be populated with your specific message and notes." _
        & Chr(10) & "I picked something real basic just to get it started. It does however work nicely."_
    , vbInformation
    
        For Each olItem In Application.ActiveExplorer.Selection
            strheader = GetInetHeaders(olItem)
        
            Set olMsg = Application.CreateItem(olMailItem)
            With olMsg
                .BodyFormat = olFormatPlain
                .Body = strheader
                .Display '= olMailItem
            End With
        Next
        Set olMsg = Nothing
    End Sub
    
    Function GetInetHeaders(olkMsg As Outlook.MailItem) As String
        ' Purpose: Returns the internet headers of a message.'
        ' Written: 4/28/2009'
        ' Author:  BlueDevilFan'
        ' //techniclee.wordpress.com/
        ' Outlook: 2007'
        Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
        Dim olkPA As Outlook.PropertyAccessor
        Set olkPA = olkMsg.PropertyAccessor
        GetInetHeaders = olkPA.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
        Set olkPA = Nothing
    End Function
    

    • Marked as answer by SteveDB1 Tuesday, November 12, 2019 5:14 PM
    Tuesday, November 12, 2019 5:14 PM