Problem submitting SPAM using Outlook VBA Form

[Geldner]

Hello,

I have been using the following code to submit reports to SPAMCOP. It works for 98% of all spam that I encounter. HOWEVER, it does not work for SPAM email that originates from Outlook.com (ie. hotmail, etc.). For some reason, the way the headers are reassembled to the email body doesn't quite work. I have no idea why. If I use SPAMCOP's online submission form and copy the headers out of the message properties box and paste them into online form, then do the same for the message body, SPAMCOP is able to parse the outlook.com SPAM.

Is there something obvious in this code that would cause the headers to get munged? Or maybe there's something that doesn't allow SPAMCOP to differentiate between the headers and the body in the forwarded mail? Help. (Note that I've munged my email and reporting address.)

Sub ForwardSpam()
    Dim olItem As Outlook.MailItem, olMsg As Outlook.MailItem
    Dim strHeader As String
    Dim strFWHeader As String
    Dim strNote As String
    Dim oAccount As Outlook.Account
    
    
    For Each olItem In Application.ActiveExplorer.Selection
        strHeader = GetInetHeaders(olItem)
    strNote = ""
        For Each oAccount In Application.Session.Accounts
            If oAccount = "xxxxxxx@gmail.com" Then
            Set olMsg = olItem.Forward
            With olMsg
                .To = "submit.<myspamcopID>@spam.spamcop.net"
                .BodyFormat = olFormatPlain
                .Body = strNote & vbCrLf & vbCrLf & strHeader & vbCrLf & vbCrLf & olItem.Body
                .SendUsingAccount = oAccount
            .Display ' change to .send when satisfied
       End With
       End If
    Next
    olItem.Delete
  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

 

[Geldner]

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
[/CODE]

Well after a bunch of fooling around and reading up on Outlook properties, I think I found the solution. So far it's working OK on Hotmail & Outlook 365 spam. Simply change the 0x007D001E value to 0x007D001F. That seems to grab the internet headers correctly. The difference is it returns PR_TRANSPORT_MESSAGE_HEADERS_W instead of PR_TRANSPORT_MESSAGE_HEADERS.

NOTE: Diane, you may want to make note of this since the snippet of code I used above came from 2009 code by BlueDevilFan on this site.

 

[Diane Poremsky]

Thanks for that information. I'll add a note to the pages that use the get header macro on my site.

If that property doesn't work correctly for internet mail, you can use an If statement find the correct property - or 2 macros. (Or 3 - one that sets one property and calls the main macro and one that sets the other and calls the main macro - the 3rd is the main macro.