【代工案例002】批量发送Word工资条
▎具体需求
某公司财务，每个月要发送几百个员工的工资条，数据均来源于Excel，需要转成Word文档格式，并发送。
Excel工资信息
Word工资条信息
收件效果
▎思路分析
首先，需要对Excel的每一行信息进行循环，一行信息生成一个Word文档。这里单独做一个word模板，把每一行工资数据直接填入Word中，涉及到向Word表格写数据的知识。
▎源代码
Sub 批量发送工资条() Set doc = CreateObject("word.application") '创建Word对象 doc.Visible = True '显示Word程序 rrow = ThisWorkbook.Worksheets(1).Range("b65536").End(3).Row For i = 2 To rrow '对个人信息进行循环 Set wd = doc.documents.Open(ThisWorkbook.Path & "\模板.docx") '打开文档，赋值给对象变量wd Set tbl = wd.tables(1) '把文档中的表格1，赋值给对对象变量tbl tbl.cell(2, 1).Range.Text = Cells(i, 3).Value '姓名 tbl.cell(2, 2).Range.Text = Cells(i, 4).Value '工资级别 tbl.cell(2, 3).Range.Text = Cells(i, 5).Value '工资档位 tbl.cell(2, 4).Range.Text = Cells(i, 6).Value '基本工资 tbl.cell(2, 5).Range.Text = Cells(i, 7).Value '综合福利补贴 tbl.cell(2, 6).Range.Text = Cells(i, 8).Value '月度绩效奖 tbl.cell(2, 7).Range.Text = Cells(i, 9).Value '预发效益奖 tbl.cell(2, 8).Range.Text = Cells(i, 10).Value '按月发放效益补贴 tbl.cell(2, 9).Range.Text = Cells(i, 11).Value '交通补贴 tbl.cell(2, 10).Range.Text = Cells(i, 12).Value '通讯补贴 tbl.cell(2, 11).Range.Text = Cells(i, 13).Value '补/扣工资 tbl.cell(4, 1).Range.Text = Cells(i, 14).Value '生活补贴 tbl.cell(4, 2).Range.Text = Cells(i, 15).Value '应发总额 tbl.cell(4, 3).Range.Text = Cells(i, 16).Value '住房公积金个人缴纳 tbl.cell(4, 4).Range.Text = Cells(i, 17).Value '养老保险个人缴纳 tbl.cell(4, 5).Range.Text = Cells(i, 18).Value '医疗保险个人缴纳 tbl.cell(4, 6).Range.Text = Cells(i, 19).Value '失业保险个人缴纳 tbl.cell(4, 7).Range.Text = Cells(i, 20).Value '大额医疗个人缴纳 tbl.cell(4, 8).Range.Text = Cells(i, 21).Value '企业年金个人缴纳 tbl.cell(4, 9).Range.Text = Cells(i, 22).Value '减：个税 tbl.cell(4, 10).Range.Text = Cells(i, 23).Value '实发合计 doc.Selection.Find.ClearFormatting doc.Selection.Find.Replacement.ClearFormatting With doc.Selection.Find .Text = "备注：" .Replacement.Text = "备注：" & Cells(i, "X").Value '书写备注信息 End With doc.Selection.Find.Execute Replace:=2 wdpath = ThisWorkbook.Path & "\" & ActiveSheet.Name & "月份工资表.docx" '保存word工资条 wd.SaveAs wdpath '另存工资条文档 wd.Close True '//开始发送邮件 Set myOlApp = CreateObject("Outlook.Application") Set objMail = myOlApp.CreateItem(olMailItem) With objMail .To = Cells(i, "Y").Value '//收件人 substr = "您好，" & Replace(ActiveSheet.Name, "工资表", "") & "工资单，请注意查收并保密，谢谢。" .Subject = substr '//主题 .Body = Cells(i, "X").Value '//正文具体内容 .Attachments.Add wdpath '//添加附件 '.display .send End With Set objMail = Nothing Next doc.Quit MsgBox "发送完成！"End Sub▎知识点
发送邮件核心代码
该方式，必须提前在OutLook中设置好账号信息。不同的邮箱类型，需要根据不同的方式进行设置。这样才能调用OutLook进行发送。
Set myOlApp = CreateObject("Outlook.Application") Set objMail = myOlApp.CreateItem(olMailItem) With objMail .To = Cells(i, "Y").Value '//收件人 substr = "您好，" & Replace(ActiveSheet.Name, "工资表", "") & "工资单，请注意查收并保密，谢谢。" .Subject = substr '//主题 .Body = Cells(i, "X").Value '//正文具体内容 .Attachments.Add wdpath '//添加附件 '.display .send End WithExcel创建Word程序并打开
该段代码作用：创建Word程序对象，并写入内容123。最后保存为例子.docx。
Sub 操作word() Set doc = CreateObject("word.application") '创建Word对象 Set wd = doc.Documents.Add doc.Visible = True strr = 123 '需要导入的字符串 .TypeText strr .TypeParagraph wd.SaveAs ThisWorkbook.Path & "\例子.docx"End SubWord中的表格对象
赞 (0)