Append contents of .msg attachment to message body - vba

Question

I have a script to open attachments and append them to the message body. I have it working for text documents but I need it working for .msg attachments too.
At the moment it just doesn't read the object. Can anyone help?
Sub RunAScriptRuleRoutine(MyMail As MailItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim olMailAT As Outlook.MailItem
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = olNS.GetItemFromID(strID)
If olMail.Subject = "lala" Then
If olMail.Attachments.Count > 0 Then
Dim strLine As String
Dim mailLine As String
Dim strLines As String
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
Open strFileName For Input As #1
Do While Not EOF(1)
Line Input #1, strLine
mailLine = mailLine + strLine
Loop
Close #1
olMailAT = mailLine
strLine = objMailAT.Body
strLines = strLines + "heres the .msg" + vbCrLf
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
Next
'save to email body and save email
olMail.Body = strLines
olMail.Save
End If
End If
Set olMail = Nothing
Set olNS = Nothing
End Sub

Answer 1

You should look into using Outlook Redemption.
Also, you should look at this documentation for format specificaion
http://msdn.microsoft.com/en-us/library/cc463912.aspx

Answer 2

To read the contents of a .msg file, I have used the following approach.
Use CreateItemFromTemplate for the msg file using the Outlook object
Use this Outlook object to save the data into a .txt file
Once the .txt file is created, read it and use the data as required
Dim OL : Set OL=CreateObject("Outlook.Application")
Dim Msg ':Set Msg= CreateObject("Outlook.MailItem")
Set Msg = OL.CreateItemFromTemplate("C:\test.msg")
'MsgBox Msg.Subject
Msg.saveAs "C:\test.txt", olDoc
'The above statement will save the contents of .msg
'file into the designate .txt file
Set OL = Nothing
Set Msg = Nothing
Once the .txt file is created use it as required for your computations.

Answer 3

By the way...for a full solution see here... http://www.geakeit.co.uk/2010/06/25/automating-email-feedback-loop-fbl-processing-and-getting-around-aol%E2%80%99s-recipient-email-address-issue/

Answer 4

Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = _
objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = _
objApp.ActiveInspector.CurrentItem
Case Else
End Select
End Function
'This is how you read the attachment using your path "strFileName"
Set OL = New Outlook.Application
Set myMessage = OL.CreateItemFromTemplate(strFileName)
myMessage.Display
Set msg2 = GetCurrentItem()
MsgBox(msg2.Body)
mg2.Close 1