Lotus Notes附件附加在身体内部,显示为灰色图标

时间:2018-07-16 11:03:26

标签: vba excel-vba lotus-notes

通过电子邮件正文中的宏添加附件时,是否有办法使附件以正确的图标显示?我的问题是,通过我的Lotus Notes宏附加.pdf或.xlsx时,它显示为通用的灰色图标,而不是.pdf或.xlsx图标。我只尝试保存电子邮件草稿,并且显示.pdf或.xlsx图标,但是当我切换宏以显示电子邮件时,它显示了通用的灰色。

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

1 个答案:

答案 0 :(得分:2)

仅在前端完成操作后,才能显示正确的图标。每当您使用LotusScript在后端附加内容时,该符号将始终是缺省符号。有XML-导出/导入的变通办法,但通常不可行。