mitchellm44
asked on
Embedded Msg, in Outlook, with a Word Doc - how to get at Embedded Msg as Attachment?
I have code that I have experimented with, that is looking at a particular Mail folder, and looking for infomation within an attachment, that has an attachment.
An Email in the inbox, has an embedded email message, that has a Word Document attached.
So, Last Sender, sends an email, from First Sender that is an embedded attachment, and There is
a Word Document from First Sender.
I can get to the embedded email- of First Sender which looks like a FILE with an extension of .Msg
and I can save that to disk, and when I open it from disk, I see the word Doc attachment.
Dim objOutLook As Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem
Dim objAttachment As Attachment
Dim objParmAttachment As Object
Dim objFSO As FileSystemObject
Dim strSaveToPath As String
Dim strFilename As String
Dim intCount As Integer
strSaveToPath = "C:\Data\Test\"
Set objOutLook = CreateObject("Outlook.Appl
Set objNameSpace = objOutLook.GetNamespace("M
Set objFolders = objNameSpace.Folders.Item(
If objFolders.Count > 0 Then
Set objFolder = objFolders.Item("Inbox")
'* the objFolder of the Inbox has the Items to be Processed
'* We can then get access to each item by looping through the inbox
'* And we can determine if there are attachements in the item.
Set objItem = objFolder.Items(1)
If objItem.Attachments.Count > 0 Then
Set objAttachment = objItem.Attachments.Item(1
Set objFSO = CreateObject("Scripting.Fi
strFilename = objAttachment.FileName
intCount = 1
Do While True
If objFSO.FileExists(strSaveT
strFilename = objFSO.GetBaseName(objAtta
intCount = intCount + 1
Else
objAttachment.SaveAsFile strSaveToPath & strFilename
Exit Do
End If
Loop
End If
.......... END OF CODE CLIP
I am hitting my head on the wall trying to see how to get this.
An Email in the inbox, has an embedded email message, that has a Word Document attached.
So, Last Sender, sends an email, from First Sender that is an embedded attachment, and There is
a Word Document from First Sender.
I can get to the embedded email- of First Sender which looks like a FILE with an extension of .Msg
and I can save that to disk, and when I open it from disk, I see the word Doc attachment.
Dim objOutLook As Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem
Dim objAttachment As Attachment
Dim objParmAttachment As Object
Dim objFSO As FileSystemObject
Dim strSaveToPath As String
Dim strFilename As String
Dim intCount As Integer
strSaveToPath = "C:\Data\Test\"
Set objOutLook = CreateObject("Outlook.Appl
Set objNameSpace = objOutLook.GetNamespace("M
Set objFolders = objNameSpace.Folders.Item(
If objFolders.Count > 0 Then
Set objFolder = objFolders.Item("Inbox")
'* the objFolder of the Inbox has the Items to be Processed
'* We can then get access to each item by looping through the inbox
'* And we can determine if there are attachements in the item.
Set objItem = objFolder.Items(1)
If objItem.Attachments.Count > 0 Then
Set objAttachment = objItem.Attachments.Item(1
Set objFSO = CreateObject("Scripting.Fi
strFilename = objAttachment.FileName
intCount = 1
Do While True
If objFSO.FileExists(strSaveT
strFilename = objFSO.GetBaseName(objAtta
intCount = intCount + 1
Else
objAttachment.SaveAsFile strSaveToPath & strFilename
Exit Do
End If
Loop
End If
.......... END OF CODE CLIP
I am hitting my head on the wall trying to see how to get this.
ASKER
Your answer is interesting, I had been using the Outlook library, to get the addressability to the Attacment, and your approach uses the CDO Library, which I had not thought of. In looking at the object browser, the CDO library shows up as MAPI (which is what is being used behind the scenes anyway) and the Attachment object with each class (Outlook.Attachment, and MAPI.Attachment) have different methods.
The change between the two libraries, does make a change from the start of the code, as it requires the Session to be established from the start as a MAPI session and not an Outlook front end to a MAPI session (which should be aCleaner approach).
The KB article link has a code example, that is dated from 2004. That example has a MAPI.Login, and sets an object to an "inbox" which does not exist
in the CDO 1.21 library (in my machine) - so the objSession.Inbox is no longer there.
Your code example picked up after that work, so I reworked my startup to get to something where you started.
Unfortunately I am at the same point -- I have an attachment that is an embedded EMAIL - but its file type is actually cdoFileData - not EmbeddedMessage.
I can see that it is a message from the ".msg" file extension in the name field.
Here is the reworked code.
'* Reference to FileScripting - Microsoft Scripting Runtime Library
'* Reference to Microsoft CDO 1.21 Library
Dim objMAPI As MAPI.Session
Dim objInfostore As MAPI.InfoStore
Dim objMAPIAttachment As MAPI.Attachment
Dim objMAPIfolders As MAPI.Folders
Dim objMAPIfolder As MAPI.Folder
Dim objMAPIMessages As MAPI.Messages
Dim objMAPIMessage As MAPI.Message
Dim objEmbeddedMessage As MAPI.Message
Dim objMAPIAttachments As MAPI.Attachments
Dim objFSO As FileSystemObject
Dim strSaveToPath As String
Dim strFilename As String
Dim intCount As Integer
strSaveToPath = "C:\Data\Test\"
Set objMAPI = CreateObject("MAPI.Session
objMAPI.Logon ("%username%")
Set objInfostore = objMAPI.InfoStores("Mailbo
Set objMAPIfolder = objInfostore.RootFolder
Set objMAPIfolders = objMAPIfolder.Folders
Set objMAPIfolder = objMAPIfolders("Inbox")
Set objMAPIMessages = objMAPIfolder.Messages
Set objMAPIMessage = objMAPIMessages.Item(1) '*First message
'* Get attachments for Message
'objMAPIMessage.Conversati
Set objMAPIAttachments = objMAPIMessage.Attachments
If objMAPIAttachments.Count > 0 Then
Set objMAPIAttachment = objMAPIAttachments.Item(1)
If objMAPIAttachment.Type = MAPI.CdoEmbeddedMessage Then
Else
If objMAPIAttachment.Type = MAPI.CdoFileData Then
'* Looks like this is actually the embedded EMAIL
'* Name has an .msg when there is the Embedded email
If InStr(1, objMAPIAttachment.Name, ".msg") > 0 Then
strFilename = objMAPIAttachment.Name
objMAPIAttachment.WriteToF
'** But there is not a way to get at that Message.
'* I need to open that message as IT contains a word doc.
'* Which I can see if I open the saved file
End If
End If
End If
End If
The change between the two libraries, does make a change from the start of the code, as it requires the Session to be established from the start as a MAPI session and not an Outlook front end to a MAPI session (which should be aCleaner approach).
The KB article link has a code example, that is dated from 2004. That example has a MAPI.Login, and sets an object to an "inbox" which does not exist
in the CDO 1.21 library (in my machine) - so the objSession.Inbox is no longer there.
Your code example picked up after that work, so I reworked my startup to get to something where you started.
Unfortunately I am at the same point -- I have an attachment that is an embedded EMAIL - but its file type is actually cdoFileData - not EmbeddedMessage.
I can see that it is a message from the ".msg" file extension in the name field.
Here is the reworked code.
'* Reference to FileScripting - Microsoft Scripting Runtime Library
'* Reference to Microsoft CDO 1.21 Library
Dim objMAPI As MAPI.Session
Dim objInfostore As MAPI.InfoStore
Dim objMAPIAttachment As MAPI.Attachment
Dim objMAPIfolders As MAPI.Folders
Dim objMAPIfolder As MAPI.Folder
Dim objMAPIMessages As MAPI.Messages
Dim objMAPIMessage As MAPI.Message
Dim objEmbeddedMessage As MAPI.Message
Dim objMAPIAttachments As MAPI.Attachments
Dim objFSO As FileSystemObject
Dim strSaveToPath As String
Dim strFilename As String
Dim intCount As Integer
strSaveToPath = "C:\Data\Test\"
Set objMAPI = CreateObject("MAPI.Session
objMAPI.Logon ("%username%")
Set objInfostore = objMAPI.InfoStores("Mailbo
Set objMAPIfolder = objInfostore.RootFolder
Set objMAPIfolders = objMAPIfolder.Folders
Set objMAPIfolder = objMAPIfolders("Inbox")
Set objMAPIMessages = objMAPIfolder.Messages
Set objMAPIMessage = objMAPIMessages.Item(1) '*First message
'* Get attachments for Message
'objMAPIMessage.Conversati
Set objMAPIAttachments = objMAPIMessage.Attachments
If objMAPIAttachments.Count > 0 Then
Set objMAPIAttachment = objMAPIAttachments.Item(1)
If objMAPIAttachment.Type = MAPI.CdoEmbeddedMessage Then
Else
If objMAPIAttachment.Type = MAPI.CdoFileData Then
'* Looks like this is actually the embedded EMAIL
'* Name has an .msg when there is the Embedded email
If InStr(1, objMAPIAttachment.Name, ".msg") > 0 Then
strFilename = objMAPIAttachment.Name
objMAPIAttachment.WriteToF
'** But there is not a way to get at that Message.
'* I need to open that message as IT contains a word doc.
'* Which I can see if I open the saved file
End If
End If
End If
End If
ASKER
One more thought.. The possiblity of creating a new message and putting it into the INBOX was a thought.. however the KB article code below has nothing in SOURCE to use..
...
If objMessage.Attachments.Cou
If objMessage.Attachments(1).
Set objEmbeddedMessage = objMessage.Attachments(1).
Set objNewMail = objEmbeddedMessage.CopyTo(
objNewMail.Update
Set objNewMail = Nothing
Set objEmbeddedMessage = Nothing
End If
End If
.....
Any thoughts?
...
If objMessage.Attachments.Cou
If objMessage.Attachments(1).
Set objEmbeddedMessage = objMessage.Attachments(1).
Set objNewMail = objEmbeddedMessage.CopyTo(
objNewMail.Update
Set objNewMail = Nothing
Set objEmbeddedMessage = Nothing
End If
End If
.....
Any thoughts?
ASKER CERTIFIED SOLUTION
membership
Create a free account to see this answer
Signing up is free and takes 30 seconds. No credit card required.
fine by me.
ASKER
Slight code correction to save the file correct. This does work
Do While True
If objFSO.FileExists(strSaveT
strFileName = objFSO.GetBaseName(objAtta
intCount = intCount + 1
Else
objNewItem.Attachments.Ite
Exit Do
End If
Loop
Do While True
If objFSO.FileExists(strSaveT
strFileName = objFSO.GetBaseName(objAtta
intCount = intCount + 1
Else
objNewItem.Attachments.Ite
Exit Do
End If
Loop
Closed, 500 points refunded.
Vee_Mod
Community Support Moderator
Vee_Mod
Community Support Moderator
see http://support.microsoft.com/kb/231958
CdoFileData = 1: CdoEmbeddedMessage = 4
Set objItem = objFolder.Items(1)
If objItem.Attachments.Count > 0 Then
Set objAttachment = objItem.Attachments.Item(1
if objAtachment.Type = CdoEmbeddedMessage Then
Set objEmbeddedMessage = objMessage.Attachments(1).
'now look at the attachments of embedded message
if objEmbeddedMessage.Attachm
Set objEMAttachment = objEmbeddedMessage.Attachm
if objEMAttachment.Type = CdoFileData Then
'can be saved ....
end if
end if
end if
end if