将 Excel 文件保存为 PDF，然后通过 Outlook 作为附件发送，但邮件中没有签名

Question

我有一些 Excel VBA 代码将活动 sheet 保存为 PDF 然后将该 PDF 文件附加到 outlook 新邮件一切正常，除了代码开始时 outlook 中的签名outlook 和新消息它不显示签名，尽管它在 HTML 中，我已经可以手动插入它了。所以对代码的任何调整将不胜感激。

Sub Send_To_Pdf()
Dim PdfPath As String
Dim BoDy As String

BoDy = Msg = "Dear Mr. " & vbCrLf & vbCrLf & "Good Day" & vbCrLf & vbCrLf & "Kindly find the attahched P.O to be delivered to " & Cells(10, 12)


PdfPath = Save_as_pdf
EnvoiMail Right(PdfPath, InStr(1, StrReverse(PdfPath), "\") - 1), "recepient1@domain.com;recepient2@domain.com", , , BoDy, 1, PdfPath
End Sub

Public Function Save_as_pdf() As String
Dim FSO As Object
Dim s(1) As String
Dim sNewFilePath As String

Set FSO = CreateObject("Scripting.FileSystemObject")

s(0) = "C:\Users\" & Environ("UserName") & "\Desktop\" & ThisWorkbook.Name

If FSO.FileExists(ThisWorkbook.FullName) Then
    '//Change Excel Extension to PDF extension in FilePath
    s(1) = FSO.GetExtensionName(s(0))

    If s(1) <> "" Then
        s(1) = "." & s(1)
        sNewFilePath = Replace(s(0), s(1), ".pdf")

        '//Export to PDF with new File Path
        ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sNewFilePath, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
    End If
Else
    '//Error: file path not found
    MsgBox "Error: this workbook may be unsaved.  Please save and try again."
End If

Set FSO = Nothing

Save_as_pdf = sNewFilePath

End Function


Sub EnvoiMail(Subject As String, Destina As String, Optional CCdest As String, Optional CCIdest As String, Optional BoDyTxt As String, Optional NbPJ As Integer, Optional PjPaths As String)
  Dim MonOutlook As Object
  Dim MonMessage As Object
  Set MonOutlook = CreateObject("Outlook.Application")
  Set MonMessage = MonOutlook.createitem(0)

  Dim PJ() As String
  PJ() = Split(PjPaths, ";")

  With MonMessage
      .Subject = Subject      '"Je suis content"
      .To = Destina           '"marcel@machin.com;julien@chose.com"
      .cc = CCdest            '"chef@machin.com;directeur@chose.com"
      .bcc = CCIdest          '"un.copain@supermail.com;une-amie@hotmail.com"
      .BoDy = BoDyTxt
        If PjPaths <> "" And NbPJ <> 0 Then
            For i = 0 To NbPJ - 1
                'MsgBox PJ(I)
              .Attachments.Add PJ(i)      '"C:\Mes Documents\Zoulie Image.gif"
            Next i
        End If
      .display
      '.send                        '.Attachments.Add ActiveWorkbook.FullName
  End With                        '?plusieurs?MonMessage.Attachments.Add "D:\Prof\Janvier\Base clients.mdb"

  Set MonOutlook = Nothing
End Sub

Answer 1

创建新消息后，您需要在默认签名前插入新文本（不要覆盖它），例如：

.BoDy = BoDyTxt

在这种情况下，默认签名将被删除。

.Body = BoDyTxt & .Body

在这种情况下，文本将被插入邮件的开头，签名保持原样。

Outlook 对象模型提供了三种不同的方式来处理项目正文：

正文 - 纯文本。
HTML正文 - HTML 标记。
Word 编辑器。 Outlook 使用 Word 作为电子邮件编辑器，因此您可以使用它来格式化电子邮件。 WordEditor 属性 Inspector class returns Document class 的一个实例，表示消息正文。

您可以在 MSDN 的 Chapter 17: Working with Item Bodies 中阅读有关所有这些方法的更多信息。

Answer 2

感谢尤金·阿斯塔菲耶夫我更改了一些代码，终于成功了

修改部分如下：

Sub EnvoiMail（主题为字符串，目的地为字符串，可选的 CCdest 为字符串，可选的 CCIdest 为字符串，可选的 BoDyTxt 为字符串，可选的 NbPJ 为整数，可选的 PjPaths 为字符串） Dim MonOutlook 作为对象 Dim MonMessage 作为对象将 strbody 调暗为字符串 'i added this part <<>>>'

设置 MonOutlook = CreateObject("Outlook.Application") 设置 MonMessage = MonOutlook.CreateItem(0) strbody = "Hello" '我也把我的消息放在这里，我在我的主代码中更改它以从单元格中获取值 <<<<>>>'

将 PJ() 调暗为字符串 PJ() = Split(PjPaths, ";")

使用 MonMessage .Display ' <<<<< 解决了 50% 问题的代码中最重要的部分 >>>>'

  .Subject = Subject
  .To = Destina
  .CC = CCdest
  .BCC = CCIdest
  .HTMLBoDy = strbody & "<br>" & .HTMLBoDy  ' <<<< the second import part of the code and solved the other 50% >>>>> '

    If PjPaths <> "" And NbPJ <> 0 Then
        For i = 0 To NbPJ - 1
            'MsgBox PJ(I)
          .Attachments.Add PJ(i)
        Next i
    End If
  .Display
  '.send

结束于

设置 MonOutlook = 无结束子

将 Excel 文件保存为 PDF，然后通过 Outlook 作为附件发送，但邮件中没有签名

Saving Excel file as PDF then send by Outlook as Attachment but no signature in the messge

pdf

excel

outlook

vba