EXCEL VBA與OUTLOOK實現批量一對一發郵件

EXCEL VBA與OUTLOOK實現批量一對一發郵件

用途：電子郵件羣發工資條、系統上線帳號分發、按店鋪分發報表文件、批量發送面試邀請郵件、批量發送面試者的錄取通知書等等

Sub sendemail()
    On Error Resume Next
    Dim i, hangshu, buchang, To_Addr$, Cc_Addr$, Bcc_Addr$, SubjectText$, HTMLBodytxt$, AttachedObject1$, AttachedObject2$
    Dim objOutlook As Object
    Dim objMail As MailItem
    Set objOutlook = CreateObject("Outlook.Application")
    hangshu = 2  '[A65536].End(xlUp).Row
    buchang = 1

For i = 2 To hangshu Step buchang

 '——————————————————————————————————————————————————
 '——————————————————————————————————————————————————
    '設置收件人地址,多個地址使用","或";"間隔。
     To_Addr = "e-mail地址"

    '設置抄送人地址,多個地址使用","或";"間隔。
     Cc_Addr = "e-mail地址"
     Bcc_Addr = ""

    '設置郵件主題
    SubjectText = "郵件主題"

    '設置郵件附件
     AttachedObject1 = ThisWorkbook.Path & "\" & "附件.txt"
     AttachedObject2 = ThisWorkbook.Path & "\" & "附件.txt"

  '——————————————————————————————————————————————————
  '——————————————————————————————————————————————————
    '設置郵件內容(從通信錄表的「內容」字段中得到)

     HTMLBodytxt = "郵件內容，支持HTML代碼"
     HTMLBodytxt = HTMLBodytxt + "郵件內容，支持HTML代碼"

  '——————————————————————————————————————————————————
  '——————————————————————————————————————————————————
If To_Addr = "" Or SubjectText = "" Or HTMLBodytxt = "" Then
  MsgBox "請檢查第" & hangshu & "行,收件人、郵件主題、郵件內容不能爲空,點擊肯定繼續下一行！"
  Else
  Set objMail = objOutlook.CreateItem(olMailItem)
   With objMail
      .To = To_Addr
    If Cc_Addr <> "" Then
      .cc = Cc_Addr
    End If
    If Bcc_Addr <> "" Then
      .BCC = Bcc_Addr
    End If
      .Subject = SubjectText
    If AttachedObject1 <> "" Then
       .Attachments.Add AttachedObject1
    End If
    If AttachedObject2 <> "" Then
       .Attachments.Add AttachedObject2
    End If
    .HTMLBody = HTMLBodytxt
    .display
   End With
  Set objMail = Nothing
End If
Next
Set objOutlook = Nothing
MsgBox (hangshu - 1) / buchang & "個數據記錄發送完成！"
End Sub