VBA學習筆記（五）：VBA發送郵件（使用Outlook）

一、以下代碼簡單實現了利用VBA通過Outlook發送郵件的功能：

具體代碼和詳細注釋如下：

Sub Example()
    
    '簡單調用示例，調用中各參數分別為："收件人","抄送人","密送人","主題","正文","附件"。
    SendEmail "[e-mail]", "", "", "jmail_free.rar", "hi,how are you !", "E:\jmail_free.rar"
    
End Sub

Sub SendEmail(To_Addr As String, Cc_Addr As String, Bcc_Addr As String, SubjectText As String, BodyText As String, AttachedObject As String)
    Dim OutlookObj As Object
    Dim OutlookNewMail As Object
    
    '創建Outlook對象
    Set OutlookObj = CreateObject("Outlook.Application")
    Set OutlookNewMail = OutlookObj.CreateItem(olMailItem)
    
    '錯誤異常處理
    On Error GoTo SendEmail_Failed
    
    With OutlookNewMail
        .To = To_Addr                   '收件人地址
        .cc = Cc_Addr                   '抄送人地址
        .BCC = Bcc_Addr                 '密送人地址
        .Subject = SubjectText          '郵件主題
        .Body = BodyText                '郵件內容
        .Attachments.Add AttachedObject '粘貼附件
        
        '.Send                          '若采用.Send方式發送郵件，則Outlook容易出現“有一個程序正試圖以您的名義發送電子郵件”提示，比較招人討厭。
                                        '若堅持采用此種方式發送郵件，又不想Outlook出現討厭的提示，則需對Outlook進行如下設置：
                                        '"工具" -> "信任中心" -> "編程訪問" -> 選擇"從不向我發出可疑活動警告"
    End With
    
    '以下是采用通過激活Outlook，然后模擬按鍵方式進行郵件發送
SendEmail_Sending:    
    '顯示發送郵件窗口
    OutlookNewMail.display 
   
    '以下目的是留給系統充分的時間點擊發送鍵
    For j = 1 To 200
        DoEvents
    Next
    
    '點擊郵件發送
    SendKeys "%s", Wait:=True
    '遺憾的是，這里無法顯示服務器發送狀態，只能返回Excel發送的結果
    MsgBox "郵件已發送！"
    Exit Sub
  
SendEmail_Failed:
    MsgBox "發送失敗，原因為：" & Err.Description
    Exit Sub
    
End Sub