Добавить содержимое вложения .msg в тело сообщения

Question

У меня есть скрипт для открытия вложений и добавления их в тело сообщения.У меня он работает для текстовых документов, но мне нужно, чтобы он работал и для вложений .msg.

В данный момент он просто не читает объект.Кто-нибудь может помочь?

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

Чтобы прочитать содержимое MSG-файла, я использовал следующий подход.

1. Используйте CreateItemFromTemplate для файла msg с использованием объекта Outlook

2. Используйте этот объект Outlook для сохранения данных в текстовый файл

3. Как только файл .txt создан, прочитайте его и используйте необходимые данные

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 

Как только файл .txt создан, используйте его в соответствии с вашими расчетами.

Answer 2

Вы должны использовать Outlook Redemption .

Кроме того, вам следует ознакомиться с этой документацией для уточнения формата. http://msdn.microsoft.com/en-us/library/cc463912.aspx

Answer 3

    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

Answer 4

Кстати ... полное решение смотрите здесь ... 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/