如何使用VBA将关联数据复制到对应路径的Word文档中

现有代码仅能操作当前处于激活状态的已打开Word文档，缺少自动按路径打开文档、文件合法性校验、进程资源释放逻辑，下方代码可直接实现全自动化批量写入流程。

核心逻辑 #

• 逐行读取工作表内存储的Word文档绝对路径、对应待写入文本内容
• 自动检测本机已打开的Word实例并复用，无可用实例时自动新建，避免重复启动程序
• 提前校验文件路径有效性，跳过无效路径避免运行中断
• 打开目标文档后将关联单元格内容写入预设位置，写完自动保存关闭文档
• 流程结束后完整释放COM对象，避免后台残留无界面Word进程占用资源

完整VBA代码 #

Sub CopyContentToLinkedWord()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long, col As Long
    Dim wordApp As Word.Application
    Dim wordDoc As Word.Document
    Dim filePath As String
    Dim cellVal As Variant
    Dim wordIsRunning As Boolean
    
    ' 配置目标工作表，可按需修改表名
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' 获取A列最后一行数据行号，默认A列存储Word文件路径
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 尝试获取已打开的Word实例，不存在则新建
    On Error Resume Next
    Set wordApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        Set wordApp = CreateObject("Word.Application")
        wordIsRunning = False
    Else
        wordIsRunning = True
    End If
    On Error GoTo ErrorHandler
    wordApp.Visible = True ' 设为False可后台静默运行
    
    ' 从第2行开始遍历数据，跳过表头行
    For i = 2 To lastRow
        filePath = ws.Cells(i, "A").Value
        ' 校验文件是否存在
        If Dir(filePath) = "" Then
            Debug.Print "第" & i & "行路径无效，跳过：" & filePath
            GoTo NextRow
        End If
        
        ' 打开目标Word文档
        Set wordDoc = wordApp.Documents.Open(FileName:=filePath)
        col = 1 ' 写入表格的起始列号
        
        ' 遍历当前行从B列开始的所有待写入单元格
        For Each cellVal In ws.Range(ws.Cells(i, "B"), ws.Cells(i, ws.Columns.Count).End(xlToLeft)).Cells
            ' 写入位置：文档第13张表格的第2行对应列，可按需修改位置参数
            wordDoc.Tables(13).Cell(2, col).Range.Text = cellVal.Value
            col = col + 1
        Next cellVal
        
        ' 保存并关闭当前文档
        wordDoc.Save
        wordDoc.Close
        Set wordDoc = Nothing
NextRow:
    Next i
    
    ' 仅退出本次流程新建的Word实例，保留用户原有打开的Word窗口
    If Not wordIsRunning Then
        wordApp.Quit
    End If
    
    ' 释放对象资源
    Set wordApp = Nothing
    MsgBox "批量写入完成！", vbInformation
    Exit Sub
    
ErrorHandler:
    MsgBox "运行出错：" & Err.Description, vbCritical
    ' 异常场景下释放资源，避免Word进程残留
    If Not wordDoc Is Nothing Then
        wordDoc.Close SaveChanges:=False
        Set wordDoc = Nothing
    End If
    If Not wordIsRunning And Not wordApp Is Nothing Then
        wordApp.Quit
    End If
    Set wordApp = Nothing
End Sub

使用配置说明 #

• 引用配置：打开VBA编辑器后依次点击「工具-引用」，勾选与本机Office版本匹配的Microsoft Word [版本号] Object Library后确认即可
• 存储列规则：代码默认读取Sheet1的A列作为Word路径存储列，从B列开始逐列读取待写入内容，存储列与实际不符时直接修改代码中对应列标参数即可
• 写入位置调整：示例默认将内容写入文档第13张表格的第2行，需调整位置时修改对应参数即可：
  • 写入其他表格/单元格：修改Tables(13).Cell(2, col)中的序号参数，三个参数依次对应表格序号、行号、列号
  • 写入书签位置：将表格写入代码替换为wordDoc.Bookmarks("自定义书签名").Range.Text = cellVal.Value即可
• 运行模式：代码默认显示Word操作窗口，将wordApp.Visible = True改为False即可切换为后台静默运行模式

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