用ExcelVBA编程快速发送邮件

如果你每天都要做报表，发给固定的收件人，你想不想只点一个按钮、立即将报表作为附件发送出去？只要你学过Excel的VBA编程，这是一件很简单的事情。

首先在报表中创建一个“邮件地址”表(当然其他名称也可以，在程序中引用这个名称即可)。收件人地址从B2开始往下加，抄送人地址从D2开始往下，密送收件人地址从F2开始往下加，G2填写主题，H2填写正文。A列、C列、E列可以填上对应的收件人姓名，但不是必须的。

密送收件人放在这里只是说明程序的使用方法，失去了密送的意义。这个收件人表也可以不需要，改为在代码中维护收件人，这是更接近实际的做法。一般初学者可以在收件人表中维护收件人信息。

B2收件人，D2抄送，F2密送，G2邮件主题，H2邮件正文

发送电子邮件代码如下：

Public Sub 发送电子邮件()

Dim OutlookApp As Outlook.Application

Dim newMail As Outlook.mailitem

Dim myAttachments As Outlook.Attachments

Dim n As Integer, i As Integer

Dim ws As Worksheet

On Error Resume Next

Set ws = Worksheets("邮件地址")

n = ws.Range("B65536").End(xlUp).Row

address = Worksheets("邮件地址").Cells(2, 2)

For i = 2 To n

If i < n Then

address = address & ";" & Worksheets("邮件地址").Cells(i + 1, 2)

End If

Next i

"CC

n = ws.Range("D65536").End(xlUp).Row

addressCC = Worksheets("邮件地址").Cells(2, 4)

For i = 2 To n

If i < n Then

addressCC = addressCC & ";" & Worksheets("邮件地址").Cells(i + 1, 4)

End If

Next i

"BCC

n = ws.Range("F65536").End(xlUp).Row

addressBCC = Worksheets("邮件地址").Cells(2, 6)

For i = 2 To n

If i < n Then

addressBCC = addressBCC & ";" & Worksheets("邮件地址").Cells(i + 1, 6)

End If

Next i

Set OutlookApp = New Outlook.Application

wbStr = ThisWorkbook.FullName "指定要发送发工作簿名称字符串

Set newMail = OutlookApp.CreateItem(olMailItem) "创建新邮件

With newMail

.Subject = Worksheets("邮件地址").Cells(2, 7) "设置邮件主题

.Body = Worksheets("邮件地址").Cells(2, 8) "设置邮件正文

"发送附件

Set myAttachments = newMail.Attachments

myAttachments.Add wbStr, olByValue, 1, "工作簿"

.To = address "收件人

.CC = addressCC "抄送

.BCC = addressBCC "密送

.Send "开始发送

End With

End Sub

请注意，要在Outlook中设置允许编程访问，具体如何设置请看我的另一篇文章“如何用Excel实现办公自动化”。否则会弹出如下对话框要你选择：

Outlook弹出的对话框

最后，添加一个加载项菜单中的按钮，链接到你编写的程序模块。点击一下按钮，即可运行程序，把你这个报表作为附件发给相关收件人。以后要发出邮件，只要点击这个按钮就可以了。