通过excel VBA实现电子邮件自动化

时间:2017-08-10 11:22:00

标签: excel-vba vba excel

我列出了从SAP下载的1000多名客户。我已经发送了一个宏来发送月度报表(pdf关于未结清的发票或未结案例)。

我的宏从A栏抓取电子邮件,下一栏是电子邮件的主题,最后一栏是电子邮件正文的正文是确切的代码:

> df <- data.frame(x=c(1,2,3,4,5), y=c(6,7,8,9,10), z=c('a','b','c','d','e'))
> df
  x  y z
1 1  6 a
2 2  7 b
3 3  8 c
4 4  9 d
5 5 10 e

ggplot(df,
  aes(x=x, y=y)+
  geom_point()

我对它进行了测试,它的效果非常好,但我想调整它。

  1. 如何在桌面上添加例如存储在.htm中的签名(让所有同事更改个性化电子邮件。
  2. 我们发送的电子邮件始终包含来自SAP报告的延迟发票列表 - 客户具有特定的SAP编号。 example
  3. 我需要以某种方式向电子邮件添加包含特定客户编号(命名为帐户)的所有未清项目。

    感谢您的帮助

2 个答案:

答案 0 :(得分:3)

关于第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

答案 1 :(得分:0)

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