简体   繁体   中英

Add signature from file and data from Excel file to Outlook email

I have a list of 1000+ of customers dowloaded from SAP. I have a macro for sending monthly statements (pdfs about outstanding invoices or open cases).

My macro grabs email address from column A, the next column is Subject of email and last one is body of the email:

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

It works but I want to adapt it.

  1. How can I add signature which is for example stored in .htm on desktop (to have it changed for all of my colleagues to personalize emails).
  2. Emails contain a list of delayed invoices also from report from SAP - customer has specific SAP number.
    例子

I need to add to the email all open items which contain the specific customer number (named as account).

Regarding part 1 , you can convert HTML to an Outlook template file (.oft) as per the instructions here:

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

That template file can then be used using the Application.CreateItemFromTemplate method as per the docs below:

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

Regarding part 2 , to include table data in the email just use something like below:

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM