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.
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:
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.