签名不出现在Excel自动化电子邮件
现在已经有一阵子把我的头撞了一下。
创build了一个日常的电子邮件发送给客户与多个pdf附件的例程。 所有这些都在工作，但由于某种原因，签名不会像通常那样自动出现。 我试图通过设置signature = outMail.body并将其添加到我的标准正文来捕获它，但似乎没有工作。 如果我以正常的方式打开电子邮件，签名会自动显示。 提前致谢。
**在.body行中使用的附加“body”只是一个包含电子邮件正文文本的varstring。
'Initial signature capture With outMail .Display End With signature = outMail.body With outMail .To = firmEmail .Subject = ****** .body = body & vbNewLine & vbNewLine & signature Do While continue = True 'Get attachments If reportsByFirm.Cells(row_counter, firmcol) = cFirm Or reportsByFirm.Cells(row_counter, firmcol) = iFirm Then pdfLocation = getPDFs(cFirm, iFirm, row_counter, reportsByFirm, trMaster, trSeparate, trName, reportDate) .Attachments.Add (pdfLocation) row_counter = row_counter + 1 ElseIf row_counter < lRowReportsByFirm Then row_counter = row_counter + 1 ElseIf row_counter >= lRowReportsByFirm Then continue = False End If Loop .Display End With 我怀疑签名最初没有添加到新的电子邮件，但后来在Outlook中的一个步骤，然后将其添加到电子邮件。 所以你的代码只是创build一个空的Body的电子邮件项目。
我已经使用这两个例程从它包含的.html文件中获取签名，然后将其添加到电子邮件中，完成为html，因此我使用.HTMLBody而不是.Body 。
Private Sub btnGenerateEmail_Click() Dim OutApp As Outlook.Application Dim OutMail As Outlook.MailItem Dim nRow As Integer Dim tblEmailTo As ListObject Dim tblEmailCC As ListObject Dim sToEmail As String Dim sCCEmail As String Dim sSalutation As String Dim dteEffectiveDate As Date Dim sSignature As String On Error GoTo EH Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(olMailItem) Set tblEmailTo = ThisWorkbook.Sheets("Ref").ListObjects("TblEmailTo") Set tblEmailCC = ThisWorkbook.Sheets("Ref").ListObjects("TblEmailCC") For nRow = 1 To tblEmailTo.ListRows.Count sToEmail = sToEmail & tblEmailTo.DataBodyRange(nRow, 1).Value & "; " Next nRow If tblEmailTo.ListRows.Count = 1 Then sSalutation = "Hi " & Mid(sToEmail, 1, InStr(1, sToEmail, ".") - 1) & "," Else sSalutation = "Hi All," End If For nRow = 1 To tblEmailCC.ListRows.Count sCCEmail = sCCEmail & tblEmailCC.DataBodyRange(nRow, 1).Value & "; " Next nRow dteEffectiveDate = Range("C" & mnDataStartRow).Value sSignature = GetCorpEmailSig() OutMail.To = sToEmail OutMail.CC = sCCEmail OutMail.Subject = "My Email Subject as at " & Format(dteEffectiveDate, "mmmm dd yyyy") OutMail.HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>" & sSalutation & _ "<br><br>My main email body text<br><br>Regards," & _ "<br>" & Mid(Application.UserName, InStr(1, Application.UserName, ",") + 2) & "</BODY>" & sSignature If Dir(GetOutputPath) <> "" Then OutMail.Attachments.Add (GetOutputPath) End If OutMail.Display Set OutMail = Nothing Set OutApp = Nothing Exit Sub Private Function GetCorpEmailSig() As String Dim sSigFilename As String Dim fso As Object Dim ts As Object sSigFilename = Environ("appdata") & "\Microsoft\Signatures\My Company Name.htm" Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(sSigFilename).OpenAsTextStream(1, -2) GetCorpEmailSig = ts.ReadAll ts.Close End Function