Question

QQ邮件怎么批量发送？

Answer 1

• 按照下图整理工资明细表

  1、列数可自行新增删除；

  2、如果整理的数据列，无法发送邮件的请把表头内添加大写字母“X”；

  3、工作表名称用作了邮件主题，发送前请修改工作表名称；

• 启用开发工具选项卡；插入命令控件；修改控件名称及显示名；

• 进入VBA编程界面；复制以下代码到编辑窗口。
  

  PrivateSub全自动发送邮件_Click()

  '要能正确发送并需要对MicroseftOutlook进行有效配置

  OnErrorResumeNext

  DimrowCount,endRowNo,endColumnNo,sFile$,sFile1$,A&,B&

  DimobjOutlookAsObject

  DimobjMailAsMailItem

  '取得当前工作表数据区行数列数

  endRowNo=ActiveSheet.UsedRange.Rows.Count

  endColumnNo=ActiveSheet.UsedRange.Columns.Count

  '取得当前工作表的名称，用来作为邮件主题进行发送

  sFile1=ActiveSheet.Name

  '创建objOutlook为Outlook应用程序对象

  SetobjOutlook=CreateObject("Outlook.Application")

  '开始循环发送电子邮件

  ForrowCount=2ToendRowNo

  '创建objMail为一个邮件对象

  SetobjMail=objOutlook.CreateItem(olMailItem)

  WithobjMail

  '设置收件人地址，数据源所在列数

  .To=Cells(rowCount,5)

  '设置抄送人地址（从通讯录表的'E-mail地址'字段中获得）

  '.CC=Cells(rowCount,0)

  '设置邮件主题,取值工作表名，

  .Subject=sFile1

  '设置邮件内容(从通讯录表的“内容”字段中获得)

  'align 单元格文本显示方式left(向左)、center(居中)、right(向右)，默认是center,width-宽height-高 border单元格线粗细,bordercolor返回或设置对象的边框颜色

  'colSpan是一种编程语言，其属性可设置或返回表元横跨的列数

  sFile="<tr>您好！<br>以下是您"+sFile1+"，请查收！</tr>"

  sFile=sFile+"<tablealign='left'width='500'height='25'border=1 bordercolor='#000000'><tbody>"

  sFile=sFile+"<tr> <tdcolspan='4'align='center'>工资表</td></tr>"

  B=1

  ForA=1ToendColumnNo

  '数据表头中添加“X”后将不发送此字段

  IfApplication.WorksheetFunction.CountIf(Cells(1,A),"*X*")=0Then

  IfB=1Then

  sFile=sFile+"<tr> <tdwidth='20%'height='25'>"+Cells(1,A).Text+" </td><td width='30%'height='25'>"+Cells(rowCount,A).Text+"</td>"

  B=0

  Else

  sFile=sFile+"<tdwidth='20%'height='25'>"+Cells(1,A).Text+" </td><td width='30%'height='25'>"+Cells(rowCount,A).Text+"</td></tr>"

  B=1

  EndIf

  EndIf

  Next

  .HTMLBody=sFile

  '设置附件(从通讯录表的“附件”字段中获得)

  .Attachments.AddCells(rowCount,24).Value

  '自动发送邮件

  .Send

  EndWith

  '销毁objMail对象

  SetobjMail=Nothing

  Next

  '销毁objOutlook对象

  SetobjOutlook=Nothing

  '所有电子邮件发送完成时提示

  MsgBoxrowCount-2&"个员工的工资单发送成功！"

  EndSub