最完美的利用EXCEL自动批量发送邮件-自动调用帐户签名自动化操作

完善的利用excel宏调用outlook自动批量发送电子邮件

在excel宏中建立两个模块，分别复制以下两个模块
（根据需要调整相应参数）

提取签名函数：
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function


主程序：
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub kaifaxin()
On Error Resume Next
Dim beforeCount
Dim yjCount
Dim i
Dim SigString As String
Dim Signature As String
Dim Savetime As Double
Dim StartTime As Date
Dim rowCount, endRowNo
Dim objOutlook As New Outlook.Application
Dim objMail As MailItem
beforeCount = 1
'取得当前工作表与Cells(1,1)相连的数据区行数
endRowNo = Cells(1, 1).CurrentRegion.Rows.Count
'创建objOutlook为Outlook应用程序对象
Set objOutlook = New Outlook.Application
'开始循环发送电子邮件
For rowCount = 1 To 1000
'创建objMail为一个邮件对象
Set objMail = objOutlook.CreateItem(olMailItem)
SigString = "C:/Users/jake/AppData/Roaming/Microsoft/Signatures/p.htm" '提取签名

If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
With objMail
If (rowCount - beforeCount) <= 100 Or (rowCount - yjCount) <= 100 Then
'设置发信帐户
.SendUsingAccount = objOutlook.Session.Accounts(1)
ElseIf ((rowCount - beforeCount) > 100 And (rowCount - beforeCount) <= 200) Or ((rowCount - yjCount) > 100 And (rowCount - yjCount) <= 200) Then
'设置发信帐户
.SendUsingAccount = objOutlook.Session.Accounts(2)
ElseIf ((rowCount - beforeCount) > 200 And (rowCount - beforeCount) <= 300) Or ((rowCount - yjCount) > 200 And (rowCount - yjCount) <= 300) Then
'设置发信帐户
.SendUsingAccount = objOutlook.Session.Accounts(3)
End If
'设置收件人地址（从通讯录表的“E-mail地址”字段中获得）
.To = Cells(rowCount, 2)
'.To = "abcd@"
'设置邮件主题
.Subject = "si"
'设置邮件内容（从通讯录表的“内容”字段中获得）
.HTMLBody = Signature
'设置附件（从通讯录表的“附件”字段中获得）
' .Attachments.Add Cells(rowCount, 4)
'显示邮件
' .Display
'自动发送邮件
.Send

Savetime = timeGetTime '记下开始时的时间
While timeGetTime < Savetime + 40000 '循环等待
DoEvents '转让控制权，以便让操作系统处理其它的事件。
Sleep 1
Wend
If (rowCount - beforeCount) = 300 Or (rowCount - beforeCount) = 600 Or (rowCount - beforeCount) = 900 Then
yjCount = rowCount
End If
End Wit

完善的利用excel宏调用outlook自动批量发送电子邮件

h
'销毁objMail对象
Set objMail = Nothing
Next
'销毁objOutlook对象
Set objOutlook = Nothing
End Sub

本文来源：https://www.bwwdw.com/article/azj4.html