[英]VBA, Insert outlook signature in vba code
我有一個 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
.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
您可能需要切換事件,不確定,因為我沒有測試禁用事件
如果您的簽名中沒有圖片並且可以使用.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
有美好的一天
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.