VBA批量发送邮件

rdmidor

好久没发帖了，将三个月前给同事做的小程序与大家分享
背景：
      销售内勤每月要从销售表格中摘抄出销售额粘贴到不同的WORD中并发送到客户那边，但客户那边要求1个订单发一封，订单上百邮件就要发送上百封，每月在这件事情上，将消耗她大半天功夫，而且极容易出错，于是本人动手帮助小妹解决问题，

以下代码 是处理 批量发送邮件 的 可封装到OUTLOOK的宏中，然后再OUTLOOKS前台定义一个按钮直接调取下面的函数 就OK 了

代码如下，欢迎评论：


Attribute VB_Name = "模块1"
Sub AddAttachment()

Dim StrFile As String, filedir As String, Recv As String, tittle As String


    Recv = "test.wang@163.com"   '收件人

    tittle = "批量发测试"    '标题

    filedir = "F:\附件\"   '附件所在目录   

    content = "连续发邮件" '收件内容     


    ' ======================程序块=================================

    StrFile = Dir(filedir)

Do While Len(StrFile) > 0
        'Debug.Print StrFile

        Dim myOlApp As New Outlook.Application
Dim myItem As Outlook.MailItem

Dim myAttachments As Outlook.Attachments

Dim MyObj As Object, MySource As Object, file As Variant


Set myItem = myOlApp.CreateItem(olMailItem)
Set myAttachments = myItem.Attachments
myAttachments.Add filedir & StrFile, olByValue, 1, "Test"  '插入附件
myItem.Subject = tittle '设定主题
myItem.Recipients.Add Recv '收件人地址
mDate = Format(Now, "yyyy-MM-dd")


        myItem.Body = content  '邮件正文
        myItem.Display
        myItem.Send

        StrFile = Dir


    Loop


End Sub

szqhb

虽然不懂，还是做个记号