EXCEL VBA与OUTLOOK实现批量一对一发邮件

转载 nn1183  2019-06-08 10:12:48  阅读 128 次 评论 0 条
重庆专业seo
摘要:

EXCEL VBA与OUTLOOK实现批量一对一发邮件用途:电子邮件群发工资条、系统上线账号分发、按店铺分发报表文件、批量发送面试邀请邮件、批量发送面试者的录取通知书等等Sub sendemail()     On Error Resume Next     Dim i, hangshu, buchang, To_Addr$,&nbs

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 = NothingEnd IfNextSet objOutlook = NothingMsgBox (hangshu - 1) / buchang & "个数据记录发送完成!"End Sub

EXCEL VBA与OUTLOOK实现批量一对一发邮件


本文地址:http://dxf6.com/post/89.html
温馨提示:文章内容系作者个人观点,不代表重庆seo对观点赞同或支持。
版权声明:本文为转载文章,来源于 nn1183 ,版权归原作者所有,欢迎分享本文,转载请保留出处!
重庆专业seo
数据湾

发表评论


表情

还没有留言,还不快点抢沙发?