如果你每天都要做報表，發給固定的收件人，你想不想隻點一個按鈕、立即将報表作為附件發送出去？隻要你學過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彈出的對話框

最後，添加一個加載項菜單中的按鈕，鍊接到你編寫的程序模塊。點擊一下按鈕，即可運行程序，把你這個報表作為附件發給相關收件人。以後要發出郵件，隻要點擊這個按鈕就可以了。

更多精彩资讯请关注tft每日頭條，我们将持续为您更新最新资讯!