VBA,在VBA代码中插入Outlook签名

我有一个vba代码,当到期date距离当前date至less7天7天时自动发送电子邮件。 问题是他们发送电子邮件时没有我的Outlook签名。 我使用outlook 2016.如果你能帮助我,这将是一个很大的帮助。

代码是:

Sub email() Dim lRow As Integer Dim i As Integer Dim toDate As Date Dim toList As String Dim eSubject As String Dim eBody As String With Application .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False End With Sheets(1).Select lRow = Cells(Rows.Count, 4).End(xlUp).Row For i = 2 To lRow toDate = Cells(i, 3) If toDate - Date <= 7 Then Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) toList = Cells(i, 4) 'gets the recipient from col D eSubject = "Doukementacion per " & Cells(i, 2) & " Targa " & Cells(i, 5) eBody = "Pershendetje Adjona" & vbCrLf & vbCrLf & "Perfundo dokumentacionin e nevojshem per " & Cells(i, 2) & " me targa " & Cells(i, 5) On Error Resume Next With OutMail .To = toList .CC = "" .BCC = "" .Subject = eSubject .Body = eBody .bodyformat = 1 '.Display ' ********* Creates draft emails. Comment this out when you are ready .Send '********** UN-comment this when you are ready to go live End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing Cells(i, 11) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column A" End If Next i ActiveWorkbook.Save With Application .ScreenUpdating = True .EnableEvents = True .DisplayAlerts = True End With End Sub 

谢谢!

我发现有帮助的是使其成为一个HTMLBody 。 所以这部分:

 With OutMail .To = toList .CC = "" .BCC = "" .Subject = eSubject .Body = eBody .bodyformat = 1 '.Display ' ********* Creates draft emails. Comment this out when you are ready .Send '********** UN-comment this when you are ready to go live End With 

会看起来像

 With OutMail .Display 'ads the signature .To = toList .Subject = eSubject .HTMLBody = eBody & .HTMLBody '.Display ' ********* Creates draft emails. Comment this out when you are ready .Send '********** UN-comment this when you are ready to go live End With 

您可能需要切换事件,不确定,因为我没有testing禁用的事件