对于批量发送邮件，大家最常用的是word的邮件合并功能，但是有一个弊端是他没有办法发附件。而很多情形，我们是希望邮件除了正文还能够包含附件。这就需要用到Excel的VBA功能了，
方案一，CSDN方案1（win7,outlook2010测试）
功能：
- 可设置变量，替换邮件正文内容；
- 彩色邮件、可换行、表格；（需了解HTML标签）
- 发送不同的附件。
图表如下：
VBA代码如下：
Public Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long
Public Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Function WinProcA(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal SysTime As Long) As Long
KillTimer 0, idEvent
DoEvents
Sleep 100
'使用Alt+S发送邮件，这是本文的关键之处，免安全提示自动发送邮件全靠它了
Application.SendKeys "%s"
End Function
' 发送单个邮件的子程序
Sub SendMail(ByVal to_who As String, ByVal subject As String, ByVal body As String, ByVal attachement As String)
Dim objOL As Object
Dim itmNewMail As Object
'引用Microsoft Outlook 对象
Set objOL = CreateObject("Outlook.Application")
Set itmNewMail = objOL.CreateItem(olMailItem)
With itmNewMail
.subject = subject '主题
.HTMLbody = body '正文本文
.To = to_who '收件者
.Attachments.Add attachement '附件
.Display '启动Outlook发送窗口
SetTimer 0, 0, 0, AddressOf WinProcA
End With
Set objOL = Nothing
Set itmNewMail = Nothing
End Sub
'批量发送邮件
Sub BatchSendMail()
Dim rowCount, endRowNo
Dim newBody
Dim replaceCount, maxReplaceCount
Dim pattern
Dim i As Integer, j As Integer
i = Cells(3, 1).Value
j = Cells(3, 2).Value
'逐行发送邮件
For rowCount = (i + 4) To (j + 4)
' 替换当前行模板内容
maxReplaceCount = 8 ' 有几个变量就写几
newBody = Cells(rowCount, 4)
For replaceCount = 1 To maxReplaceCount
pattern = "[==" & CStr(replaceCount) & "==]"
newBody = WorksheetFunction.Substitute(newBody, pattern, Cells(rowCount, 5 + replaceCount))
Next
' 替换好了，发邮件咯！
SendMail Cells(rowCount, 2), Cells(rowCount, 3), newBody, Cells(rowCount, 5)
Next
Cells(3, 1).Value = i + 5
Cells(3, 2).Value = j + 5
End Sub
注意：
- 正文需用HTML标签， HTML代码可以在W3C school测试效果。
常用HTML标签：
- 段落:
<p></p> - 加粗：
<b></b> - 颜色：
<font color="red"></font>
提示：仅仅有 16 种颜色名被 W3C 的 HTML4.0 标准所支持。它们是：aqua, black, blue, fuchsia, gray, green, lime, maroon, navy, olive, purple, red, silver, teal, white, yellow。3
变量部分用[==xxxx==]这样的形式替换掉。注意：中间没有空格。 数字[==1==]会被E列的内容替换掉，[==2==]会被F列的内容替换掉，依此类推，如果有更多，就添加更多列，[==3==], [==4==]等等。
- 附件路径中可以有中文，但是不能有空格。每一行将是一个邮件
为了正确执行代码，还需要在菜工具->引用 中的Microseft Outlook X.0 Object Library 勾选上 （X.0是版本号）
表格方案二：知乎方案 2 ，结合CSDN （win10,outlook2017测试)
对于excel工作表，从A1开始，可描述题头：第一列：收件人；第二列：主题；第三列：正文；第四列：附件路径； 第五列：变量一； 第六列：变量二
从A2开始，对应题头填写实际收件人，主题，正文，附件路径，变量……
代码如下：
Sub sendBatchMail()
t = Timer '计时器开始
Dim rowCount, endRowNo
Dim objOutlook As New Outlook.Application
Dim objMail As MailItem
Dim sendIndex
Dim replaceCount, maxReplaceCount
Dim pattern
endRowNo = Cells(1, 1).CurrentRegion.Rows.Count
Set objOutlook = New Outlook.Application
ThisWorkbook.Sheets("sheet1").Select
For rowCount = 2 To endRowNo '循环从第二行运行到最后一行
' 替换当前行模板内容
maxReplaceCount = 2 ' 有几处替换就写几，有2个变量，就写2
newBody = Cells(rowCount, 3)
For replaceCount = 1 To maxReplaceCount
pattern = "[==" & CStr(replaceCount) & "==]"
newBody = WorksheetFunction.Substitute(newBody, pattern, Cells(rowCount, 4 + replaceCount)) ' 从4+N列为变量
Next
'替换完毕
Set objMail = objOutlook.CreateItem(olMailItem)
subjectname = ThisWorkbook.Sheets("sheet1").Range("b" & rowCount) '赋值邮件名
bodyname = newBody '赋值邮件正文
attach_address = ThisWorkbook.Sheets("sheet1").Range("d" & rowCount) '赋值附件路径
With objMail
.To = Cells(rowCount, 1)
.Attachments.Add attach_address
.HTMLBody = bodyname
.Subject = subjectname
sendIndex = rowCount Mod objOutlook.Session.Accounts.Count + 1
'要发的邮件分到服务器上
.SendUsingAccount = objOutlook.Session.Accounts.Item(sendIndex)
.Send
End With
Set objMail = Nothing
Application.Wait (Now + TimeValue("0:00:5"))
'发完一封邮件等5秒左右，时间可以自己调整
Next
MsgBox "发送完毕!" & Chr(10) & "用时" & Timer - t & "seconds" & Chr(10) & "A VBA application modified by colinjiang.com"
'结束后，显示计时器结果
End Sub
参考文献
- CSDN． 利用Excel批量快速发送电子邮件 [OL]． https://blog.csdn.net/maray/article/details/8133923
- 知乎 闲者秋山 ．用Excel和OutLook实现自动批量发邮件[OL]．https://zhuanlan.zhihu.com/p/25283201
- HTML 颜色[OL].https://www.w3school.com.cn/html/html_colors.asp