作者：绿色风
分类：
时间：2022-08-18
浏览：178
楼主
芐雨 |
Q：如何根据工作表分别进行邮件合并？设计好一个word模板，但每次选择一张工作表作为数据源 进行邮件合并，然后保存 。再选在第二张工作表 。（一旦工作表多了就比较麻烦）
A：可以利用VBA来完成上面的操作
代码如下：
- Sub 邮件合并_芐雨()
- Dim sht As Worksheet
- Dim wdApp As Object
- Dim DocName As String
- Dim wbName As String
- Application.ScreenUpdating = False '关闭Excel屏幕更新，加快程序运行速度
- ReDim arr(1 To Sheets.Count, 1 To 2)
- For Each sht In Worksheets '把工作表的名称与对应的记录数放入数组
- x = x + 1
- arr(x, 1) = sht.Name
- arr(x, 2) = sht.Cells(Rows.Count, 1).End(3).Row - 1
- Next
- DocName = "准考证.doc"
- On Error Resume Next '如果出错继续执行程序
- Set wdApp = GetObject(, "word.application")
- If wdApp Is Nothing Then
- Set wdApp = CreateObject("word.application")
- wdApp.Visible = True
- End If
- Set WdDoc = wdApp.Documents.Open(ThisWorkbook.Path & "\" & DocName)
- wdApp.ScreenUpdating = False '禁止Word屏幕更新，加快运行速度。
- On Error GoTo 0
- wbName = ThisWorkbook.FullName
- For i = 1 To UBound(arr)
- With WdDoc.MailMerge '邮件合并
- .OpenDataSource Name:=wbName, _
- ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
- AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
- WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
- Connection:= _
- "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & wbName & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global " _
- , SQLStatement:="SELECT * FROM [" & arr(i, 1) & "$]", SQLStatement1:="", SubType:= _
- wdMergeSubTypeAccess
- .Destination = wdSendToNewDocument
- .SuppressBlankLines = True
- With .DataSource
- .FirstRecord = 1 '合并记录从1到最后
- .LastRecord = arr(i, 2)
- End With
- .Execute Pause:=False
- End With
- With wdApp.ActiveDocument '按工作表的名称保存word
- .SaveAs Filename:=ThisWorkbook.Path & "\" & arr(i, 1)
- .Close
- End With
- Next
- wdApp.Quit wdDoNotSaveChanges '退出word
- Application.ScreenUpdating = True
- MsgBox "完成合并"
- End Sub
PS：如果路径过长，会提示字符串超过255！
附件 ：
 A.rar
|
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一