Saving a .msg file with images
Hi All, after getting snippets of help over time I thought I'd share this solution as it had taken a lot of googling to bring it all together. The fix isn't specific to CM as it wasn't needed if I'd just been sending the mail, but was needed to save it as a file and then load to CM.
There is also a flaw as the message is saved to CM before it is sent, and there is a possibility that it either isn't sent or it is edited before it's Sent but the business area were happy to accept that.
I had a task to create a Outlook message from an Excel spreadsheet, and to TRIM a copy of it.
The message was created as HTMLFormat and I could embed the images using either img src=<filename> or img src='cid:<contentid>' but while the images appeared Ok in Outlook and would send, when the .msg file was saved and then copied to CM the images weren't included.
When I used src='cid:<contentid>' I was relying on the contentid being the same as the filename (without path or extension) and as the file was being displayed I though all was well. After much searching I found that it is possible to specify the content ID. Once I did that the msg was saved to filsesystem successfully and could then be added to CM.
I used the Replace as didn't seem to like spaces in content ID.
So the relevant bits are (please excuse the formatting) .
The names of the images files to be attached are in first column of a worksheet hence the reference to ws.Cells(n, 1).Value
Dim olmail As Outlook.MailItem
Dim olkPA As Outlook.PropertyAccessor
Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
BodyFormat = olFormatHTML
If rowUsed > 1 Or Not IsEmpty(ws.Range("A1").Value) Then
.HTMLBody = .HTMLBody & "<br><B>Image(s) included:</B><br><br>"
For n = 1 To rowUsed
.Attachments.Add ws.Cells(n, 1).Value, olByValue
Set olkPA = .Attachments(n).PropertyAccessor
olkPA.SetProperty PR_ATTACH_CONTENT_ID, Replace(GetFilenameFromPath(ws.Cells(n, 1).Value), " ", "")
. HTMLBody = .HTMLBody & "<img src='cid:" & Replace(GetFilenameFromPath(ws.Cells(n, 1).Value), " ", "") & "'>" & "<br><br>"
'Save as msg file
strFileName = "C:\temp\" & Replace(.Subject, "/", "-") & ".msg"
Do While IsFileOpen(strFileName)
MsgBox ("Please Close " & strFileName)
.SaveAs strFileName, olMSG
n = SetTRIMRecord(strFileName, .Subject)
These two functions are used.
The records are saved to a given CM folder.
Public Function SetTRIMRecord(strFileName As String, Optional strTitle As String)
Dim docToAdd As TRIMSDK.InputDocument
Dim myRT As TRIMSDK.RecordType
Dim myRec As TRIMSDK.Record
Dim myContainer As TRIMSDK.Record
Dim bolVerify As Boolean
Set myRT = tDatabase.GetRecordType("Document")
Set myRec = tDatabase.NewRecord(myRT)
If Not strTitle = "" Then
myRec.Title = strTitle
myRec.Title = strFileName
Set docToAdd = New InputDocument
Set myContainer = GetTRIMRecord("059330")
myRec.Container = myContainer
' MsgBox "CONTAINER IS " & myRec.Container.Title
bolVerify = myRec.SetDocument(docToAdd, False, False, "created via SDK")
bolVerify = myRec.Verify(True)
If bolVerify Then
MsgBox (myRec.Number + " saved")
and I grabbed this one
Function GetFilenameFromPath(ByVal strPath As String) As String
' Returns the rightmost characters of a string upto but not including the rightmost '\'
' e.g. 'c:\winnt\win.ini' returns 'win.ini'
If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)