Sub RunAScriptRuleRoutine(MyMail As MailItem)

Dim strID As String
Dim olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim strLine As String
Dim strLines As String
Dim sItem, oItem, fso
    
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = olNS.GetItemFromID(strID)

Set sItem = CreateObject("Redemption.SafeMailItem")
Set oItem = Application.Session.GetDefaultFolder(16).Items.Add(6)
sItem.Item = oItem

If olMail.Attachments.Count > 0 Then
    For i = 1 To olMail.Attachments.Count
        strFileName = "C:\emailTemp\" + olMail.Attachments.Item(i).FileName
        
        If InStr(strFileName, ".msg") Then
            olMail.Attachments.Item(i).SaveAsFile strFileName
            strLines = strLines + "//Start of " + strFileName + " //" + vbCrLf

            sItem.Import strFileName, 3
            sItem.Save
            strLines = strLines + "Recipient:" + sItem.To + vbCrLf + sItem.HTMLBody

            strLines = strLines + "//End of " + strFileName + " //" + vbCrLf
        Else
            olMail.Attachments.Item(i).SaveAsFile strFileName
            strLines = strLines + "//Start of " + strFileName + " //" + vbCrLf

            Open strFileName For Input As #1
                Do While Not EOF(1)
                Line Input #1, strLine
                    strLines = strLines + vbCrLf + strLine
                Loop
            Close #1
                
            strLines = strLines + "//End of " + strFileName + " //" + vbCrLf
        End If
        
        Set fso = CreateObject("Scripting.FileSystemObject")
        fso.DeleteFile (strFileName)
        
    Next
    
olMail.Body = strLines
olMail.Save

End If

Set olMail = Nothing
Set olNS = Nothing
Set sItem = Nothing
Set oItem = Nothing
Set fso = Nothing

End Sub