簡體   English   中英

將來自文件的簽名和來自 Excel 文件的數據添加到 Outlook 電子郵件

[英]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. 我如何添加例如存儲在桌面上的 .htm 中的簽名(讓我的所有同事對其進行更改以個性化電子郵件)。
  2. 電子郵件包含同樣來自 SAP 報告的延遲發票列表 - 客戶具有特定的 SAP 編號。
    例子

我需要將包含特定客戶編號(稱為帳戶)的所有未清項添加到電子郵件中。

關於第 1 部分,您可以按照此處的說明將 HTML 轉換為 Outlook 模板文件 (.oft):

http://smallbusiness.chron.com/convert-html-oft-52249.html

然后可以根據以下文檔使用Application.CreateItemFromTemplate方法使用該模板文件:

https://msdn.microsoft.com/en-us/vba/outlook-vba/articles/application-createitemfromtemplate-method-outlook

關於第 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.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM