Word邮件合并VBA宏运行过慢、FILLIN字段重复弹窗问题求助

问题描述 #

该宏用于打开带合并域占位符的Word信函文档，执行邮件合并操作填充信函发件人信息，同时会提示用户输入自定义值填充收件人姓名和地址（使用FILLIN域，而非MERGE域）。
发件人信息存储在Excel电子表格中，运行时首个弹窗要求输入每位发件人唯一的登录ID。该宏功能可正常运行但效率极低，打开docx文件需要数秒，光标处于加载状态时用户无法获知运行进度，已添加消息框提示用户耐心等待，需求是加快docx文档的打开速度。提问者表示该宏是拼接现有代码片段编写，并非VBA专家。

初始版本代码 #

Sub Letter()
Dim wrdObj As Object, wrdDoc As Object
Dim strFile As String, myKey As String
Dim mySource As String: mySource = "C:\LetterMemoDB.xls"

Set wrdObj = CreateObject("Word.Application")
myKey = InputBox("Enter sender's login ID (e.g., jtorres or b324):")
MsgBox ("Please wait a moment. If the template doesn't automatically open, go to the Word icon in the taskbar and open it from there. ")
With wrdObj
    .Visible = True
    .Activate
    .DisplayAlerts = wdAlertsNone
        Set wrdDoc = .Documents.Open("C:\NewLetterTemplate.docx", False, True, False, , , , , , , , False)
        With wrdDoc
            With .MailMerge
                .MainDocumentType = wdFormLetters
                .Destination = wdSendToNewDocument
                .SuppressBlankLines = True
                .OpenDataSource Name:=mySource, ReadOnly:=True, AddToRecentFiles:=False, _
                  LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
                  "Data Source=mySource;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
                  SQLStatement:="SELECT * FROM [All_Users$] WHERE LoginID = '" & myKey & "'"
                .Execute Pause:=True
            End With
    .Close 0
        End With
    .Activate
End With
Set wrdDoc = Nothing: Set wrdObj = Nothing
End Sub

参考Excel表格结构 #

第一次代码更新 #

根据Charles Kenyon的建议修改代码后，出现填充FILLIN字段时弹出两次输入提示的问题：

Sub Letter_V2()
Dim myKey As String
Dim mySource As String: mySource = "C:\LetterMemoDB.xls"

Documents.Add Template:="C:\ NewLetterTemplate.docx", NewTemplate:=False
 myKey = InputBox("Enter sender's login ID (e.g., jtorres or b324):")
    With ActiveDocument.MailMerge
        .MainDocumentType = wdFormLetters
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        .OpenDataSource Name:=mySource, ReadOnly:=True, AddToRecentFiles:=False, _
          LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
          "Data Source=mySource;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
          SQLStatement:="SELECT * FROM [All_Users$] WHERE LoginID = '" & myKey & "'"
        .Execute Pause:=False
    End With

End Sub

2021年6月4日第二次代码更新 #

添加了Office 2016的Word对象库引用，修改后代码如下，提问者表示尚未完全理解「前期绑定」与「后期绑定」的区别：

Option Explicit

Sub Letter()
Dim wrdObj As Word.Application
Dim wrdDoc As Word.Document
Dim excObj As Excel.Application
Dim strFile As String, myKey As String
Dim mySource As String: mySource = "C:\LetterMemoDB.xls"

Set wrdObj = CreateObject("Word.Application")
Set excObj = CreateObject("Excel.Application")

myKey = InputBox("Enter sender's login ID (e.g., jtorres or b324):")
'MsgBox ("Please wait a moment. If the template doesn't automatically open, go to the Word icon in the taskbar and open it from there. ")
With wrdObj
    .Visible = True
    .Activate
    .DisplayAlerts = wdAlertsNone
        Set wrdDoc = .Documents.Open("C:\NewLetterTemplate.docx", False, True, False, , , , , , , , False)
        With wrdDoc
            With .MailMerge
                .MainDocumentType = wdFormLetters
                .Destination = wdSendToNewDocument
                .SuppressBlankLines = True
                .OpenDataSource Name:=mySource, ReadOnly:=True, AddToRecentFiles:=False, _
                  LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
                  "Data Source=mySource;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
                  SQLStatement:="SELECT * FROM [All_Users$] WHERE LoginID = '" & myKey & "'"
                .Execute Pause:=True
            End With
    .Close 0
        End With
    .Activate
End With
Set wrdDoc = Nothing: Set wrdObj = Nothing
Close excObj
Set excObj = Nothing
End Sub

优化解决方案 #

运行速度优化 #

1. 调整Word应用可见性时机：不要在宏运行初期就设置.Visible = True，等邮件合并完成后再显示窗口，可减少界面渲染带来的性能损耗
2. 关闭屏幕更新：宏运行前添加wrdObj.ScreenUpdating = False，运行结束后再恢复为True，大幅减少加载过程中的界面重绘开销
3. 移除冗余Excel对象：当前代码中创建的excObj全程没有被调用，直接删除相关声明、创建和销毁代码即可，减少不必要的进程启动开销
4. 修复数据源连接字符串错误：原连接字符串里Data Source=mySource是硬编码字符串，改为Data Source=" & mySource & "，避免重复解析路径带来的额外开销
5. 改用模板格式加载：将现有docx模板另存为dotx Word标准模板格式，使用Documents.Add加载模板比直接打开docx文件效率更高，还能避免原模板被意外修改

FILLIN域重复弹窗问题修复 #

两次弹窗是因为FILLIN域在模板加载、合并执行两个阶段都会被触发，可在执行邮件合并前添加wrdDoc.Fields.Locked = True锁定域，合并生成新文档后再按需解锁即可。

前期绑定与后期绑定说明 #

• 前期绑定：提前引用对应版本的Office对象库，声明变量时直接用Word.Application这类具体类型，运行效率更高，代码编写时还有智能提示，缺点是如果使用环境的Office版本和开发版本不一致可能出现兼容性问题
• 后期绑定：声明变量用Object类型，运行时才创建对象，兼容性更好，但运行效率稍低，没有智能提示
  如果使用环境的Office版本统一，推荐用前期绑定，否则选择后期绑定即可。

内容的提问来源于stack exchange，提问作者Anubix