Feedback loop email processing - VBA script?

We send over 100,000 emails per day to a subscriber list however some emails are inadvertently marked as spam by those recipients who are no longer active, have forgotten about their membership. We subscribe to the feedback loops provided by Yahoo, Hotmail and AOL covering all their respective domains. Feeback loop alerts are delivered as emails to one of our admin addresses and come in two forms, namely 1) one with the full original email as an attachment (this accounts for 80% of all feedback alerts) and 2) the others with the original email as an attachment but with the recipient email address redacted. Within all of those emails is contained the subscriber's unique membership ID (can be identified by the string 'id=xxxxx').

I need to script the extraction of both types of feedback loop email in order to flag accounts and no longer send them emails. Once I have extracted the recipient email address or unique user ID I will process this data in a SQL database, either automatically as an additional step to the extraction process, or manually using a batch process. The main efficiency I'm looking for at present is the extraction of the email address from the feedback loop email attachment.

I'm assuming others must have come across this issue and will have developed VBA scripts to address this challenge.
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Robberbaron (robr)Commented:
i have something a little similar in that i have a catch mailbox from which emails are moved to the proper storage folder.
But this is done on the server, not at the client which appears to be how you are approaching the problem.

my app runs every 10min, processes any emails in a nominated mailbox, moves them if possible and flags those that cant be interpreted.
But as i said, it is a server app written in c# (was vb6)
drl1DirectorAuthor Commented:
I'd be happy to run this server-side. I just figured the obvious solution may be to run it client-side but am open to either. Is there any source code you can share? Are you extracting content from emails that arrive as attachments as per my scenario?
Robberbaron (robr)Commented:
1. are you working against an exchange server or POP server ?
2. my code only looks into the email header and processes based upon that. attached is the part that processes each message to a RTF format for printing. it may be of assistance.  Note this is old code and I now use c# directly against the Exchange mailbox using the Exchange services API. google EWS-Managed-API.aspx was very useful.
3. in what format is the return email attachment ?   other than text, i dont have any ideas.
' needs a form with RichText box

Public Sub Save2RTF(pr_Id As String, pr_QA As String, rtBX As RichTextBox, mapiMsg As Message)

    Dim q As Integer, txtWidth As Single
    Dim margin As String, sMsg As String, sRTfile As String
    Dim oTmp As Object, oAttCol As Object, oAtt As Object
    'Dim pr_ID As String, pr_QA As String
        'defaults from vers 3
        rtBX.Height = 16836
        rtBX.Width = 11904
        txtWidth = 151.06   ' (RTb.Width - marg_left - marg_right) / Printer.TextWidth(String(1, "-")) * 0.7

        'marg_left = 25: marg_right = 10: marg_top = 10: marg_bottom = 10

        rtBX.TextRTF = ""  'set to blank
        rtBX.Font.Size = 11
        rtBX.Font.Name = "Arial"
        rtBX.Font.Bold = False
        rtBX.SelFontSize = 11
        'form base message data
        rtBX.SelText = "FROM : " & mapiMsg.Sender.Name & vbCrLf
        rtBX.SelText = "SENT : " & Format(mapiMsg.TimeSent, "ddd dd/mmm/yyyy ttttt") & vbCrLf
        rtBX.SelHangingIndent = TwipMM * 20
        For q = 1 To 3
            Select Case q
                Case MAPI.CdoTo
                    rtBX.SelText = "TO : "
                Case MAPI.CdoCc
                    rtBX.SelText = "CC : "
                Case MAPI.CdoBcc
                    rtBX.SelText = "BCC : "
            End Select
            sMsg = ""
            For Each oTmp In mapiMsg.Recipients
                If oTmp.Type = q Then
                    rtBX.SelText = oTmp.AddressEntry.Name & " ; "
                End If
            Next oTmp
            rtBX.SelText = vbCrLf  'end the line
        Next q
        rtBX.SelText = "SUBJECT : " & mapiMsg.Subject & vbCrLf
        rtBX.SelText = String(txtWidth * 0.8, "-") & vbCrLf

        rtBX.SelHangingIndent = TwipMM * 5
        margin = ""
        'find out if we have RichText sMsg
        '   get it from Compressed format
        '   margin = MessageGetRTF(mapiMsg)
        If margin = "" Then
            rtBX.SelText = mapiMsg.Text
            rtBX.SelRTF = margin
        End If
        rtBX.SelHangingIndent = 0
        rtBX.SelIndent = TwipMM * 10
        rtBX.SelText = vbCrLf & "--//-- Attached files --//--" & vbCrLf
        'List Attachments
        sMsg = ""
        Set oAttCol = mapiMsg.Attachments
        q = 0
        For Each oAtt In oAttCol
             sMsg = ": "
             q = q + 1
             sMsg = oAtt.Name & vbTab
             Select Case oAtt.Type
                Case 1
                    sMsg = sMsg & "  -:- File"
                Case 2
                    sMsg = sMsg & "  -:- FileLink"
                Case 3
                    sMsg = sMsg & "  -:- OLE Object"
                Case 4
                    sMsg = sMsg & "  -:- Embedded Message"
             End Select
             rtBX.SelIndent = TwipMM * 10
             rtBX.SelText = Format(q, " ##") & Space(8) & sMsg & vbCrLf
        Next oAtt
        rtBX.SelIndent = TwipMM * 10
        rtBX.SelText = "--//-- End Attachments --//--" & vbCrLf
        rtBX.SelIndent = 0
        rtBX.SelStart = 0: rtBX.SelAlignment = rtfRight
        rtBX.SelBold = True: rtBX.SelFontSize = 24
        rtBX.SelText = "Email Message"
        rtBX.SelText = String(txtWidth * 0.1, " ")
        rtBX.SelText = "file:: " & pr_Id & vbCrLf
        rtBX.SelAlignment = rtfRight
        rtBX.SelBold = True: rtBX.SelFontSize = 24
        rtBX.SelText = pr_QA & vbCrLf
        rtBX.SelBold = False
        rtBX.SelAlignment = rtfLeft
        sRTfile = sRTFileLoc & "EMSG_" & pr_Id & "_" & Format(mapiMsg.TimeSent, "yyyymmddHhNnSs") & ".rtf"
        rtBX.SaveFile sRTfile, rtfRTF
End Sub

'needs Pr_Split somewhere in project

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

drl1DirectorAuthor Commented:
Thanks for the code. I'm working with an Exchange 2010 server. The email, which arrives as an attachment, is in HTML format.
Robberbaron (robr)Commented:
so you can check the attachments collection to see if there are any and then save the html attachment as a temp text file, then open the text file.
drl1DirectorAuthor Commented:
The attachment is an HTML email, so the attachment itself is .msg format. From that attached .msg I want to extract the contents of the TO: field.

I now have a partial solution which I'm still working on to finalise so wil lclose this question down.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.