Excel中批量發送郵件

在日常工作中，經常會遇到需要群發郵件的情況，正常情況下只有一個個手工寫郵件，然後發送。這樣的工作效率可想而知。下面就介紹一個通過群發郵件的VBA程序。

一、數據準備

準備如下圖的數據表，包括以下內容：

1）第一列為「郵件地址」，必須是完整的帶後綴的郵件地址。

2）第二列為「郵件主題」，不同的收件人可以根據需要寫不同的主題。

3）第三列為「郵件內容」，不同的收件人可以根據需要寫不同的內容。這裡的內容在發送時是以純文本格式發送的，在單元格里設置的格式均無效。

4）第四列為「郵件附件」，附件必須帶有完整的路徑，且必須包括文件擴展名。

5）第五列為「郵件簽名」，簽名必須帶有完整的路徑，且必須包括文件擴展名。這裡的郵件簽名是自動提取使用者郵箱里設置的簽名，如果沒有設置簽名，那麼將為空。

二、插入按鈕

1、點擊「開發者工具」頁面，選擇「插入」中的「控制項工具」。然後選擇「命令按鈕」，如下圖所示：

2、畫出按鈕

在表格下面空白處畫出「命令按鈕」。這時候該按鈕默認為編輯狀態，按鈕四周也有編輯框。如下圖所示：

三、輸入代碼

1、雙擊可編輯狀態的「命令按鈕」，便進入VBA代碼編輯器。

2、複製以下代碼到VBA編輯器中。替換掉編輯器里原有的兩行內容。

PrivateSub CommandButton1_Click()

"要能正確發送並需要對MicroseftOutlook進行有效配置

On Error Resume Next

Dim rowCount, endRowNo

Dim objOutlook As New Outlook.Application

Dim objMail As MailItem

Dim SigString As String

Dim Signature As String

"取得當前工作表與Cells(1,1)相連的數據區行數

endRowNo = Application.WorksheetFunction.CountIfs(Range("A:A"),"")

"創建objOutlook為Outlook應用程序對象

Set objOutlook = New Outlook.Application

"開始循環發送電子郵件，比如從第二行開始，第一行是標題

For rowCount = 2 To endRowNo

Set objMail =objOutlook.CreateItem(olMailItem) "創建objMail為一個郵件對象

"提取郵件簽名

SigString =Worksheets("Sheet1").Cells(2, 5)

If Dir(SigString) "" Then

Signature =GetBoiler(SigString)

Else

Signature = ""

End If

With objMail

.To = Cells(rowCount,1).Value "設置收件人地址（從Excel表的第一列"郵件地址"欄位中獲得）

.Subject = Cells(rowCount,2).Value "設置郵件主題（從Excel表的第二列"郵件主題"欄位中獲得）

.HTMLBody = Cells(rowCount,3).Value & Signature "設置郵件內容（從Excel表的第三列"郵件內容"欄位中獲得）

.Attachments.Add Cells(rowCount,4).Value "設置附件（從Excel表的第四列"附件"欄位中獲得）

.Send

End With

Set objMail = Nothing "銷毀objMail對象

Next

MsgBox ("郵件全部發送完成！")

Set objOutlook = Nothing "銷毀objOutlook對象

End Sub

"提取郵件簽名子函數

FunctionGetBoiler(ByVal sFile As String) As String

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

EndFunction

未完待續……

喜歡這篇文章嗎？立刻分享出去讓更多人知道吧！