Having problems with your account or logging in?
A lot of changes are happening in the community right now. Some may affect you. READ MORE HERE

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

With thanks to https://stackoverflow.com/questions/44375973/send-email-with-embedded-images-through-excel

Sub cmdEmailReport

Dim olmail As Outlook.MailItem
Dim olkPA As Outlook.PropertyAccessor

Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"


With olmail

    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>"
        Next n
    End If

    '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)

End With

End Sub

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
End If

Set docToAdd = New InputDocument
docToAdd.SetAsFile (strFileName)

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")
    MsgBox (myRec.ErrorMessage)
End If

End Function

and I grabbed this one
'from https://stackoverflow.com/questions/1743328/how-to-extract-file-name-from-path
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)
End If
End Function


The opinions expressed above are the personal opinions of the authors, not of Micro Focus. By using this site, you accept the Terms of Use and Rules of Participation. Certain versions of content ("Material") accessible here may contain branding from Hewlett-Packard Company (now HP Inc.) and Hewlett Packard Enterprise Company. As of September 1, 2017, the Material is now offered by Micro Focus, a separately owned and operated company. Any reference to the HP and Hewlett Packard Enterprise/HPE marks is historical in nature, and the HP and Hewlett Packard Enterprise/HPE marks are the property of their respective owners.