Excel VBA,在VBA代码中插入outlook签名
我有一个vba代码,当到期日距离当前日期至少7天时自动发送电子邮件 问题是,当电子邮件发送时没有我的outlook签名 代码是:Excel VBA,在VBA代码中插入outlook签名,excel,vba,outlook,outlook-2016,Excel,Vba,Outlook,Outlook 2016,我有一个vba代码,当到期日距离当前日期至少7天时自动发送电子邮件 问题是,当电子邮件发送时没有我的outlook签名 代码是: 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 .En
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
Sub-email()
Dim lRow作为整数
作为整数的Dim i
日期
作为字符串的Dim toList
作为字符串的Dim-eSubject
暗黑如弦
应用
.ScreenUpdate=False
.EnableEvents=False
.DisplayAlerts=False
以
第(1)页。选择
lRow=单元格(Rows.Count,4).结束(xlUp).行
对于i=2至lRow
toDate=单元格(i,3)
如果toDate-Date我发现有用的是将它变成一个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
您可能需要切换事件,不确定,因为我没有在禁用事件的情况下进行测试如果您的签名中没有图片,并且可以使用.body
,那么我认为您可以使用这个最简单的工具
Sub Mail_Workbook_1()
Dim OutApp As Object
Dim Outmail As Object
Set OutApp = CreateObject("Outlook.Application")
Set Outmail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.Display
End With
Signature = OutMail.body
With OutMail
.Subject = "This is the Subject line"
.Body = strbody & Signature
.Send 'or use .Display
End with
On Error GoTo 0
Set Outmail = Nothing
Set OutApp = Nothing
End Sub
祝你有美好的一天这一点的可能重复是错误的-你无法连接2个HTML文档并生成有效的HTML文档-你的数据需要插入到HTML正文中的适当位置。这是有效的,但可能是因为我使用它一年左右运气好,或者我在“正文”中遗漏了什么。从中发现的灵感在该链接上起作用,因为所附加的数据不是一个带有HTML和head标记的完整HTML文档。在本例中,您是在有效的HTML文档开始之前添加数据。如果Outlook能够解析出这一点,那么您就很幸运了。一般来说,情况并非如此。你是对的。希望它有助于找到正确的解决方案正确的解决方案是将两者合并。请参阅我的答案