![](/img/trans.png)
[英]Inserting Signature into Outlook email from Excel VBA
[英]Add signature from file and data from Excel file to Outlook email
我有一份從 SAP 下載的 1000 多個客戶的列表。 我有一個用於發送月結單的宏(關於未結發票或未結案件的 pdf)。
我的宏從 A 列中獲取電子郵件地址,下一列是電子郵件的主題,最后一列是電子郵件的正文:
Sub SendMail()
Dim objOutlook As Object
Dim objMail As Object
Dim ws As Worksheet
Set objOutlook = CreateObject("Outlook.Application")
Set ws = ActiveSheet
For Each cell In ws.Range("A2:A1000")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = cell.Value
.Subject = cell.Offset(0, 1).Value
.Body = cell.Offset(0, 2).Value
.Attachments.Add cell.Offset(0, 3).Value
'display will show you email before it is sent, replace it with "send" and it will sent email without displaying
.send
End With
Set objMail = Nothing
Next cell
Set ws = Nothing
Set objOutlook = Nothing
End Sub
它有效,但我想適應它。
我需要將包含特定客戶編號(稱為帳戶)的所有未清項添加到電子郵件中。
關於第 1 部分,您可以按照此處的說明將 HTML 轉換為 Outlook 模板文件 (.oft):
http://smallbusiness.chron.com/convert-html-oft-52249.html
然后可以根據以下文檔使用Application.CreateItemFromTemplate
方法使用該模板文件:
關於第 2 部分,要在電子郵件中包含表格數據,只需使用以下內容:
Dim OutApp As Object: Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0) ' or use the template method specified in pt 1.
Dim html As String: html = "<html><body><table>"
Dim row As String
' the two lines below should be changed to include data from your excel
' table when filtered. Repeat the two lines below for the rows as required
row = "<tr><td> .... </td></tr>"
html = html & row
' once the rows are processed, close off the html tags
html = html & "</table></body></html>"
With OutMail
.To = "email_address@email.com"
.CC = ""
.BCC = ""
.HTMLBody = html
.BodyFormat = olFormatHTML
.Display ' or .Send
End With
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As LongPtr, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As LongPtr
Sub SendEmail()
Dim email As String
Dim subject As String
Dim msg As String
Dim mailURL As String
Dim i As Integer
Dim tableRange As Range
On Error Resume Next
Set tableRange = Application.InputBox("Please select the data range:", "Custom Email Sender", Type:=8) ''Type 8 is cell reference
If tableRange Is Nothing Then Exit Sub ''A little error handeling incase someone accidentily doesn't select a range
If tableRange.Columns.Count <> 4 Then
MsgBox "You must select 4 columns of data. Please try again"
Exit Sub
End If
For i = 1 To tableRange.Rows.Count
email = tableRange.Cells(i, 3)
subject = "Thank you for your Recent Purchase at Think Forward Computer Services"
''Create the message
msg = "Hi " & tableRange.Cells(i, 1) & ", "
msg = msg & "We want to thank you for your recent business at our store! We really appreciate it."
msg = msg & "If you have any questions or concerns about your " & tableRange.Cells(i, 4) & " we're here to help. Just reply to this email at anytime " _
& "or call us at 555-555-5555 between the hours of 8am - 8pm " & vbNewLine & vbNewLine & "Thanks Again, " & vbNewLine & "Think Forward Computer Services"
mailURL = "mailto:" & email & "?subject=" & subject & "&body=" & msg
Call Shell(sCmd, vbNormalFocus)
''Send the Email
ShellExecute 0&, vbNullString, mailURL, vbNullString, vbNullString, vbNormalFocus
''Wait for email client to open
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
Next
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.