如何用VBA将Word模板存为.docx？解决Excel批量生成Word文档报错

我需要将Excel工作表中的文本数据批量生成多个独立Word文档（一行数据对应一个文档，每个字段前包含对应列标题），文档名称取自工作表指定字段。因为需要特定格式和数据排列顺序（仅部分字段参与），我用带书签的Word模板配合VBA填充数据，填充过程正常，但循环中尝试将模板另存为标准Word文档时，出现“对象不支持该属性或方法”（错误483）。请问如何解决该问题，或是否有更优实现方法？

原问题代码 #

Sub Primitive()

Dim objWord As Object
Dim ws As Worksheet
Dim i As Integer


   
    Set ws = ThisWorkbook.Sheets("Sheet1")
    i = 2 ' First row to process
    'Start of loop
    Do Until ws.Range("B" & i) = ""
         Set objWord = CreateObject("Word.Application")
         objWord.Visible = True
     'Change to local path of template file
     

         objWord.Documents.Open "C:path of template file.dotx"
         With objWord.ActiveDocument


              .Bookmarks("FirstBookmark").Range.Text = ws.Range("B" & i).Value & " " & ws.Range("C" & i)
              .Bookmarks("headlineZ").Range.Text = ws.Range("Z1").Value
' 此处省略大量类似代码用于整理文档数据
           
              NewFileName = "C:\path of where I want the new file" & ws.Range("C" & i).Value & ".docx"
' 报错行：
    objWord.SaveAs2 Filename:="NewFileName"
    End With
    

    objWord.Close

 Set objWord = Nothing
        

              
        i = i + 1
        Loop
   


End Sub

错误原因分析 #

1. 方法调用对象错误：SaveAs2 是Word文档（Document）对象的方法，你错误地用Word应用程序（Application）对象objWord去调用，导致属性/方法不支持的错误。
2. 变量引用错误：你给NewFileName加了双引号，程序会把它当成固定字符串"NewFileName"，而不是你拼接好的动态路径。
3. 资源浪费：循环内每次创建新的Word应用实例，不仅效率低，还容易导致后台残留未关闭的Word进程。

修复后的完整代码 #

Sub BatchGenerateWordDocs()
    Dim objWord As Object
    Dim ws As Worksheet
    Dim i As Integer
    Dim doc As Object ' 定义文档对象
    Dim NewFileName As String
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    ' 提前创建一次Word应用实例，避免循环内重复创建
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True ' 调试时可设为True，正式运行可改为False提升速度
    
    i = 2 ' 从第2行开始处理数据
    Do Until ws.Range("B" & i).Value = ""
        ' 打开模板文档，赋值给doc对象
        Set doc = objWord.Documents.Open("C:\你的模板文件路径.dotx")
        
        With doc
            ' 填充书签数据（示例保留原代码逻辑，按需补充其他字段）
            .Bookmarks("FirstBookmark").Range.Text = ws.Range("B" & i).Value & " " & ws.Range("C" & i).Value
            .Bookmarks("headlineZ").Range.Text = ws.Range("Z1").Value
            
            ' 拼接保存路径（注意路径末尾要加反斜杠，避免文件名和路径连在一起）
            NewFileName = "C:\保存目标文件夹路径\" & ws.Range("C" & i).Value & ".docx"
            
            ' 用文档对象调用SaveAs2，直接使用变量NewFileName，不要加引号
            .SaveAs2 Filename:=NewFileName, FileFormat:=12 ' 12对应docx格式（wdFormatXMLDocument）
            .Close ' 关闭当前生成的文档
        End With
        
        Set doc = Nothing ' 释放文档对象
        i = i + 1
    Loop
    
    ' 循环结束后关闭Word应用并释放资源
    objWord.Quit
    Set objWord = Nothing
End Sub

额外优化建议 #

• 保留书签（可选）：如果填充数据后需要保留书签供后续使用，不要直接覆盖书签范围的文本，而是先保存书签位置，填充后重新添加书签：

  Dim bmkRange As Object
  Set bmkRange = doc.Bookmarks("FirstBookmark").Range
  bmkRange.Text = ws.Range("B" & i).Value & " " & ws.Range("C" & i).Value
  doc.Bookmarks.Add Name:="FirstBookmark", Range:=bmkRange
  

• 错误处理：添加错误捕获，防止中途出错导致Word进程残留：

  On Error Resume Next
  ' 你的代码逻辑
  If Err.Number <> 0 Then
      MsgBox "处理第" & i & "行时出错：" & Err.Description
      ' 出错时关闭当前文档和Word应用
      If Not doc Is Nothing Then doc.Close False
      objWord.Quit
      Set doc = Nothing
      Set objWord = Nothing
      Exit Sub
  End If
  On Error GoTo 0
  

• 路径合法性：确保保存路径存在，可提前用Dir函数检查，不存在则创建文件夹：

  Dim savePath As String
  savePath = "C:\保存目标文件夹路径\"
  If Dir(savePath, vbDirectory) = "" Then
      MkDir savePath
  End If
  

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