你是否遇到这样的情况,要给合作商点对点发送带有附件的邮件,如果合作商比较少,20个以内还好,一个个发送需要的时间还不算很多,如果几百个甚至上千个,依然一个个发送真是要累死啊,有什么办法可以批量点对点发送带有附件的邮件呢?之前小编分享过邮件合并的功能,Excel与word的并肩作战之邮件合并,但是如果邮件要带附件呢?今天给大家分享如何批量点对点发送带有附件的邮件。操作步骤如下: step1:先准备好附件、邮件正文内容、合作商的邮件收件人和抄送人、附件所在的文件路径。 比如,邮件正文内容: 图 1 合作商收件人和抄送人以及需要发送的附件所在的文件路径: 图 2 这里建议邮箱先设置为自己的邮箱测试,千万别写合作商的邮箱。 Step2:点击开发工具→表单控件,插入表单控件,修改控件名称为你自己想设置的名称。 图 3 Step3:点击开发工具→查看代码,点击视图→工程资源管理器,找到模块1,双击输入以下代码: 图 4 Sub Mygirl() '要能正确发送并需要对MicroseftOutlook进行有效配置 On Error Resume Next Dim rowCount, endRowNo '要正常运行下面这句,要将工具/引用中的Microseft Outlook *.0 Object Library(其中*为你Microseft Outlook的版本号)选上 Dim objOutlook As New Outlook.Application Dim objMail As MailItem '取得当前工作表与Cells(1,1)相连的数据区行数 endRowNo = Cells(1,1).CurrentRegion.Rows.Count '创建objOutlook为Outlook应用程序对象 Set objOutlook = New Outlook.Application '开始循环发送电子邮件 For rowCount = 2 To endRowNo A =Application.WorksheetFunction.Clean(Worksheets("发送清单").Cells(rowCount, 3)) '创建objMail为一个邮件对象 Set objMail =objOutlook.CreateItem(olMailItem) With objMail '设置收件人地址 .To = Cells(rowCount, 1) '设置抄送收件人地址 .CC = Cells(rowCount, 2) '设置邮件主题 .Subject = Worksheets("正文").Cells(1, 2) '设置邮件内容 .Body = Worksheets("正文").Cells(2, 2) '设置附件 .Attachments.Add A '自动发送邮件 .Send End With '销毁objMail对象 Set objMail = Nothing Next X = (endRowNo - 1) & "封邮件都发完了哦" MsgBox X End Sub 大功告成,测试一下,太棒了,所有邮件一次性搞定,均带有附件。 案例模版下载地址: http:///5aSb9Dp 今天的分享到此结束,如果想看更多历史文章,请从菜单所有文章查看。 |
|
来自: sunnynie2021 > 《待分类》