Lotus Notes Attachment attached inside body showing as gray icons - vba

Question

Is there a way to get the attachment to appear with the correct icon when you add it through the macro inside body of email?. My issue is that when attaching a .pdf or .xlsx through my lotus notes macro it appears as a generic grey icon rather than the .pdf or .xlsx icon. I tried only saving a draft of the email and it shows the .pdf or .xlsx icon but when I switched my macro to display the email it shows a generic grey one.
Private Maildb As Object ' The Mail Database
Private Username As String ' The current users notes name
Private MailDbName As String ' The Current Users Notes mail database name
Private MailDoc As Object 'the mail document itself
Private AttachME As Object ' The attachement richtextfile object
Private session As Object ' The Notes Seesion
Private EmbedObj As Object ' The Embedded Object (attachment)
Private ws As Object 'Lotus Workspace
Private objProfile As Object
Private rtiSig As Object, rtitem As Object, rtiNew As Object
Private uiMemo As Object
Public strToArray() As String, strCCArray() As String, strBccArray() As String
'
Public Function f_SendNotesEmail(strAtask As String, strTo As String, strCC As String, strBcc As String, _
strObject As String, strBody As String, blnSaveIt As Boolean) As Boolean
Dim strSignText As String, strMemoUNID As String
Dim intSignOption As Integer
Set session = CreateObject("Notes.NotesSession")
Set ws = CreateObject("Notes.NotesUIWorkspace")
Username = session.Username
MailDbName = Left$(Username, 1) & Right$(Username, (Len(Username) - InStr(1, Username, " "))) & ".nsf"
On Error GoTo err_send
Set Maildb = session.GETDATABASE("", MailDbName)
If Maildb.IsOpen = False Then Maildb.OPENMAIL
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
MailDoc.SendTo = strTo
MailDoc.CopyTo = strCC
'MailDoc.BlindCopyTo = strBcc
MailDoc.subject = strObject
MailDoc.SAVEMESSAGEONSEND = blnSaveIt
Set objProfile = Maildb.GetProfileDocument("CalendarProfile")
intSignOption = objProfile.GetItemValue("SignatureOption")(0)
strSignText = objProfile.GetItemValue("Signature")(0)
'Signature or not
If intSignOption = 0 Then
MailDoc.body = strBody
Else
'Insert a Signature
Select Case intSignOption
Case 1: 'Plain text Signature
Set rtitem = MailDoc.CreateRichTextItem("Body")
Call rtitem.AppendText(strBody)
Call rtitem.AppendText(Chr(10)): Call rtitem.AppendText(Chr(10))
Call rtitem.AppendText(strSignText)
Case 2, 3: 'Document or Rich text
'Open memo in ui
Set uiMemo = ws.EditDocument(True, MailDoc)
Call uiMemo.GotoField("Body")
'Check if the signature is automatically inserted
If objProfile.GetItemValue("EnableSignature")(0) <> 1 Then
If intSignOption = 2 Then
Call uiMemo.Import(f_strSignatureType(strSignText), strSignText)
Else
Call uiMemo.ImportItem(objProfile, "Signature_Rich")
End If
End If
Call uiMemo.GotoField("Body")
'Save the mail doc
strMemoUNID = uiMemo.Document.UniversalID
uiMemo.Document.MailOptions = "0"
Call uiMemo.Save
uiMemo.Document.SaveOptions = "0"
Call uiMemo.Close
Set uiMemo = Nothing
Set MailDoc = Nothing
'Get the text and the signature
Set MailDoc = Maildb.GetDocumentByUNID(strMemoUNID)
Set rtiSig = MailDoc.GetFirstItem("Body")
Set rtiNew = MailDoc.CreateRichTextItem("rtiTemp")
Call rtiNew.AppendText(strBody)
Call rtiNew.AppendText(Chr(10)): Call rtiNew.AppendText(Chr(10))
strFile = Dir(strPath & "*.xlsx")
Do While Len(strFile) > 0
'.AppendText ("hiui")
'Set AttachME = MailDoc.CreateRichTextItem("ATTACHMENT" & strFile) 'attaching as attachments not inside body
Call rtiNew.embedobject(1454, "", strPath & strFile, "ATTACHMENT")
'.AddNewLine (1)
strFile = Dir
Loop
Call rtiNew.AppendRTItem(rtiSig)
'Remove actual body to replace it with the new one
Call MailDoc.RemoveItem("Body")
Set rtitem = MailDoc.CreateRichTextItem("Body")
Call rtitem.AppendRTItem(rtiNew)
End Select
End If
MailDoc.Save False, False
Set uiMemo = ws.EditDocument(True, MailDoc)
f_SendNotesEmail = True
label_end:
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set session = Nothing
Set EmbedObj = Nothing
Set rtitem = Nothing
Set uiMemo = Nothing
Set rtiSig = Nothing
Set rtiNew = Nothing
Set ws = Nothing
Exit Function
err_send:
f_SendNotesEmail = False
GoTo label_end
End Function

Answer 1

Showing the correct icon only works when done in the frontend. Whenever you use LotusScript to attach something in the backend, the symbol will always be the default one. There are workarounds with XML- Export / Import, but usually they are not feasible.