VBA从Excel调用Word模板生成文档：部分用户首次运行异常

问题根源分析 #

首次运行仅打开文档、后续填充保存无响应，主要由以下原因导致：

• Word首次启动存在加载延迟，后续代码在文档未完全就绪时执行，导致操作失效
• 模板路径存在多余空格，部分系统无法正确识别路径，首次运行无法加载模板内容
• Excel未引用Word对象库时，wdFormatDocumentDefault常量未定义，错误被On Error Resume Next掩盖
• GetObject获取Word实例的逻辑存在不确定性，首次创建实例时初始化不彻底

解决方案 #

1. 修复模板路径错误 #

移除templates后的多余空格，确保路径可被系统正确识别：

TemplateName = "C:\Users\" & VBA.Environ("UserName") & "\AppData\Roaming\Microsoft\templates\MyLetter.dotm"

2. 添加Word就绪等待机制 #

创建Word实例后，等待程序完全就绪，避免加载延迟导致后续代码执行失败：

WaitTime = 0
Do While oApp.Ready = False And WaitTime < 5000
    DoEvents
    WaitTime = WaitTime + 100
    Sleep 100 ' 需要在模块顶部添加声明：
    ' #If VBA7 Then
    '     Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
    ' #Else
    '     Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    ' #End If
Loop

3. 替换未定义的Word常量 #

Excel未引用Word库时，用数值替代wdFormatDocumentDefault（16对应docx格式）：

oDoc.SaveAs2 Filename:=... , FileFormat:=16

4. 调整实例创建逻辑 #

强制创建新的Word实例，避免复用已有实例的不确定性：

Set oApp = CreateObject("Word.Application")

5. 添加错误捕获与书签检查 #

增加错误捕获逻辑，同时检查书签是否存在，避免因缺失书签报错：

On Error GoTo ErrorHandler
If oDoc.Bookmarks.Exists("Adresse") Then
    oDoc.Bookmarks("Adresse").Range.Text = Adresse
End If

修改后的完整代码 #

#If VBA7 Then
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub GenerateWordDocument(Adresse As String, Nachname As String)
    Dim oApp As Object ' 后期绑定，无需引用Word库
    Dim oDoc As Object
    Dim TemplateName As String
    Dim DesktopPath As String
    Dim WaitTime As Integer
    
    ' 修复后的模板路径
    TemplateName = "C:\Users\" & VBA.Environ("UserName") & "\AppData\Roaming\Microsoft\templates\MyLetter.dotm"
    DesktopPath = "C:\Users\" & VBA.Environ("UserName") & "\Desktop\"
    
    ' 创建新的Word实例
    Set oApp = CreateObject("Word.Application")
    oApp.Visible = True
    
    ' 等待Word就绪（最多等待5秒）
    WaitTime = 0
    Do While oApp.Ready = False And WaitTime < 5000
        DoEvents
        WaitTime = WaitTime + 100
        Sleep 100
    Loop
    
    On Error GoTo ErrorHandler
    ' 基于模板创建文档
    Set oDoc = oApp.Documents.Add(Template:=TemplateName)
    
    ' 检查并填充书签
    If oDoc.Bookmarks.Exists("Adresse") Then
        oDoc.Bookmarks("Adresse").Range.Text = Adresse ' 直接替换书签内容，而非追加
    End If
    
    ' 格式化日期，避免文件名非法
    oDoc.SaveAs2 Filename:=DesktopPath & "Brief " & Nachname & " " & Format(Date, "yyyy-mm-dd") & ".docx", FileFormat:=16
    
Cleanup:
    Set oDoc = Nothing
    ' 可选：若不需要保留Word窗口，可取消注释以下代码
    ' oApp.Quit
    Set oApp = Nothing
    Exit Sub
    
ErrorHandler:
    MsgBox "执行出错：" & Err.Description, vbCritical
    Resume Cleanup
End Sub

额外优化点 #

• 采用后期绑定：无需在Excel中引用Word对象库，避免版本差异导致的兼容性问题
• 格式化日期：用yyyy-mm-dd格式命名文件，避免系统区域设置不同导致文件名包含非法字符
• 显式清理对象：确保Word实例和文档对象被正确释放，避免内存泄漏

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