如何用Word Userform批量填充多份文档的书签内容？

嘿，我完全懂你的困扰——好不容易做了能单文档填充的Userform，结果要给同一个顾问发多份合同还得重复输入信息，实在太折腾人了！咱们直接把现有代码改造一下，就能实现一次输入、批量搞定所有合同，下面是具体步骤：

第一步：改造Userform的提交逻辑 #

先把用户在Userform里输入的信息存成变量，再调用批量处理的核心过程，而不是直接填充当前文档。假设你的Userform有txtName（顾问姓名）、txtAddress（顾问地址）这类输入控件，修改提交按钮的代码如下：

Private Sub CommandButton1_Click()
    ' 把用户输入的信息暂存到变量里
    Dim consultantName As String
    Dim consultantAddress As String
    ' 可以根据你的需求添加更多字段，比如电话、邮箱等
    consultantName = Me.txtName.Value
    consultantAddress = Me.txtAddress.Value
    
    ' 调用批量填充的核心函数，把信息传进去
    BatchFillContracts consultantName, consultantAddress
    
    ' 关闭Userform
    Unload Me
End Sub

第二步：编写批量处理的核心过程 #

这个过程会让你选择存放合同的文件夹，然后自动遍历所有合同文档，逐个填充信息并保存（默认另存为新文件，避免覆盖原模板）：

Sub BatchFillContracts(consName As String, consAddr As String)
    Dim folderDialog As FileDialog
    Dim targetFolder As String
    Dim currentDoc As Document
    Dim docFileName As String
    
    ' 弹出文件夹选择框，让用户选合同所在的文件夹
    Set folderDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With folderDialog
        .Title = "请选择存放合同文档的文件夹"
        If .Show = -1 Then
            targetFolder = .SelectedItems(1) & "\"
        Else
            ' 用户取消选择，直接退出
            Exit Sub
        End If
    End Set
    
    ' 遍历文件夹里的所有Word文档（支持.doc和.docx格式）
    docFileName = Dir(targetFolder & "*.doc*")
    Do While docFileName <> ""
        ' 打开当前合同文档
        Set currentDoc = Documents.Open(targetFolder & docFileName)
        
        ' 👇这里替换成你原来单文档的填充逻辑👇
        ' 如果你用的是书签填充：
        If currentDoc.Bookmarks.Exists("bm_Name") Then
            currentDoc.Bookmarks("bm_Name").Range.Text = consName
        End If
        If currentDoc.Bookmarks.Exists("bm_Address") Then
            currentDoc.Bookmarks("bm_Address").Range.Text = consAddr
        End If
        ' 如果你用的是内容控件填充，就改成：
        ' currentDoc.SelectContentControlsByTitle("cc_Name").Item(1).Range.Text = consName
        
        ' 另存为带前缀的新文件，避免覆盖原模板
        currentDoc.SaveAs2 targetFolder & "已填充_" & consName & "_" & docFileName
        ' 关闭文档
        currentDoc.Close wdSaveChanges
        
        ' 取下一个文件继续处理
        docFileName = Dir()
    Loop
    
    MsgBox "批量填充完成！所有已填充的合同都保存在原文件夹下，前缀为「已填充_」"
End Sub

第三步：几个关键注意事项 #

• 确保合同里的书签/内容控件名称和代码里的一致，比如代码里的bm_Name要和你合同里的书签名称完全匹配，不然会填充失败。
• 如果你的合同是模板文件（.dotx/.dot），可以把Documents.Open改成Documents.Add Template:=targetFolder & docFileName，这样会基于模板生成新文档再填充。
• 可以自由扩展字段，比如在Userform里加txtPhone控件，然后在代码里添加对应变量和填充逻辑就行。

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