Email Bounce handling with vbscript

Basically, what we need to do:
1 - Setup a new email account to store all bounced emails.
2 - Designate the bounce-back email to a dedicated email address. For easy handling, I set a custom header in the email to store the email address to track.
e.g. x-MyCustomHdr =
3 - Create a script to parse this mailbox, and save the email address to a database table. This script comes with an INI file. Credits to http://www.westphil.nl/systemadministration/vbscript/index.php?name=mailread for the original source code.

Pre-requisites:
Since Outlook 2007, Microsoft no longer bundles the MAPI.Session ActiveX object. This component needs to be installed on the machine. The component can be downloaded from Microsoft: http://www.microsoft.com/download/en/details.aspx?DisplayLang=en&id=3671
The solution is only 32bit compatible.
Outlook needs to be installed on the machine.

This is a script to parse an Outlook account, and save the email address to database.

'On Error Resume next

Dim objSession
Dim objIs 
Dim objFldSource
Dim objFldDestination
Dim objMessage
Dim objAttachment
Dim ivalue 
Dim strSubj, strBody, strEmail
Dim strConn, objConn

strIniFile = "MailRead.ini"
strSection = "Config"


strMapiProfile = ReadINI(strINIFile, strSection, "MapiProfile")
strMailBox = ReadINI(strINIFile, strSection, "MailBox")
strKey = ReadINI(strINIFile, strSection, "MailHeader")

strConn = "Driver={SQL Server};Data Source=XXXXXXX;Database=XXXXXXXX;UID=XXXXXXXXXX;PWD=XXXXXXXXXXXXXX;"
set objConn = CreateObject("ADODB.Connection")
objConn.open strConn

' Logon
Set objSession = CreateObject("MAPI.Session")
Call objSession.Logon(strMapiProfile)
Wscript.echo "Log on to profile : " & strMapiProfile 

' Get Mailbox
Set objIs = objSession.InfoStores(strMailBox) 
Wscript.echo "Logged on to Mailbox : " & objIs.name

' Get Root folder, inbox and deleted items
Set objFldSource = objIs.RootFolder
'Wscript.echo objFldSource.Folders.Count
For Each objF in objFldSource.Folders
 If objF.Name = "Inbox" Then
  Set objFldSource = objF
 End If
 If objF.Name = "Deleted Items" Then
  Set objFldDestination = objF
 End If
 'WScript.Echo objF.Name
Next

' Loop through messages. 
With objFldSource.Messages
  For Index = .Count To 1 Step -1 
   
   With .Item(Index)
     ' Process the message.
       Set objMessage = objFldSource.Messages(Index) 
 strSubj = objMessage.Subject
 strBody = objMessage.Text
       Wscript.Echo strSubj

 ' Get the original email
 arrLines = Split(strBody,vbCrLf)
 strEmail = ""
 Wscript.echo "Attempting to parse " & strKey 
 For Each strLine in arrLines
 
         If UCase(Left(strLine, Len(strKey) + 1)) = UCase(strKey & ":") Then
           strEmail = Mid(strLine, InStr(strLine, ": ") + 1)
   Wscript.Echo strEmail
           Exit For
         End If
 Next
 UpdateInvalidEmail objConn, strEmail, strSubj

       ' Move the message.
       Call .MoveTo(objFldDestination.ID) 
   End With

  Next
End With

Wscript.Echo "Finised parsing mailbox."

objConn.Close
Set objConn = Nothing

' Uitloggen.
Call objSession.Logoff 
Set objSession = Nothing

Function ReadINI(strINIFile, strSection, strKey)
 Dim objFSO, objTextFile, strLine
 
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Set objTextFile = objFSO.OpenTextFile(strINIFile)
 
 'loop through each line and check for key value
 Do While Not objTextFile.AtEndOfStream
   strLine = objTextFile.ReadLine
   'wscript.echo strLine
   If UCase(strLine) = UCase("[" & strSection & "]") Then
     Do While Not objTextFile.AtEndOfStream
       strLine = objTextFile.ReadLine
       If UCase(Left(strLine, Len(strKey) + 1)) = _
          UCase(strKey & "=") Then
         ReadINI = Mid(strLine, InStr(strLine, "=") + 1)
         Exit do
       End If
     Loop
     Exit Do
   End If
 Loop
 
 objTextFile.Close
 
End Function

Sub UpdateInvalidEmail(objConn, email, subject)

 If Len(email) > 50 Then email = Left(email, 50)
 If Len(subject) > 500 Then subject = Left(subject, 500)

 email = Replace(email, "'", "''")
 subject = Replace(subject, "'", "''")
 objConn.Execute "sp_UpdateInvalidEmails '" & email & "', '" & subject & "'"

End Sub

MailRead.ini

[Config]
;name of outlook profile to use
MapiProfile=Default Outlook Profile
;Name of mailbox as it appears in outlook
MailBox=Mailbox - Sender Name
;Any special extra headers
MailHeader=x-MyCustomHdr