如何打开Excel中嵌入的Word OLE对象、填数据并优化VBA代码？

需要实现的功能：在Excel中打开嵌入的Word文档（OLE对象），将Sheet1的数据填入这份8页的文档后保存到桌面，全程后台执行。现有代码偶尔可用，但频繁出现以下问题：

• 重复声明Word应用实例（wdApp、wdApp2）
• 依赖MsgBox延迟来规避“Microsoft Excel正在等待另一个应用完成OLE操作”及后续的错误1004
• wdObj.Activate 偶尔触发错误1004
• 桌面存在同名文件时保存出错
• 逻辑顺序错误：先保存模板再填入数据

现有代码 #

' SAVE THE TEMPLATE ON THE DESKTOP
Application.ScreenUpdating = False
' Filename
strFileName = GetDesktop & "\METPR" & Sheet1.Cells(13, 10).Value & "rev" & Sheet1.Cells(13, 12).Value & ".docx"
' WORD object
Dim wdApp As Object
Set wdApp = CreateObject("Word.Application")
' Initialisation
Dim wdObj As Object
Set wdObj = Sheet1.OLEObjects("T_Conv")
' Activation
wdObj.Activate
' Save the new Document
wdApp.ActiveDocument.SaveAs (strFileName)
' End of objects
wdApp.Application.Quit
Set wdObj = Nothing
Set wdApp = Nothing
' Temporisation to avoid error 1004 !
MsgBox ("The Word Document METPR" & Sheet1.Cells(13, 10).Value & "rev" & Sheet1.Cells(13, 12).Value & " has been saved on your Desktop.")
' OPEN THE TEMPLATE AND LOAD DATA
' WORD object
Dim wdApp2 As Object
Set wdApp2 = CreateObject("Word.Application")
' Initialisation
Dim wdObj2 As Word.Document
Set wdObj2 = wdApp2.Documents.Open(strFileName)
' Activation
wdObj2.Activate
'------------------------------------------------------------
' Fill the document WORD with Data extracted from this XL file
'------------------------------------------------------------
' Save the new Document
wdApp2.ActiveDocument.Save
' End of objects
wdApp2.Application.Quit
Set wdObj2 = Nothing
Set wdApp2 = Nothing
Application.ScreenUpdating = True

优化后代码 #

Sub FillEmbeddedWordAndSave()
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim oleObj As OLEObject
    Dim strFileName As String
    Dim desktopPath As String
    
    ' 开启后台执行模式，关闭屏幕更新与提示弹窗
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' 获取系统桌面路径
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    strFileName = desktopPath & "\METPR" & Sheet1.Cells(13, 10).Value & "rev" & Sheet1.Cells(13, 12).Value & ".docx"
    
    ' 处理同名文件：存在则删除（可改为重命名，根据需求调整）
    If Dir(strFileName) <> "" Then
        Kill strFileName
    End If
    
    ' 直接获取嵌入的Word OLE对象，无需重复创建Word应用
    Set oleObj = Sheet1.OLEObjects("T_Conv")
    ' 从OLE对象直接调用Word文档，跳过激活操作
    Set wdDoc = oleObj.Object
    Set wdApp = wdDoc.Application
    
    ' 设置Word后台运行，不显示界面
    wdApp.Visible = False
    wdApp.DisplayAlerts = 0 ' 关闭Word所有提示弹窗
    
    ' ========================
    ' 此处编写数据填充逻辑
    ' 示例：wdDoc.Bookmarks("Bookmark1").Range.Text = Sheet1.Cells(1,1).Value
    ' 根据Word文档中的书签/位置替换为实际填充代码
    ' ========================
    
    ' 先填充数据再保存，修正逻辑顺序
    wdDoc.SaveAs2 Filename:=strFileName, FileFormat:=16 ' 16对应docx格式
    
    ' 释放资源，清理对象
    wdDoc.Close SaveChanges:=False
    oleObj.Close
    wdApp.Quit
    
    Set wdDoc = Nothing
    Set wdApp = Nothing
    Set oleObj = Nothing
    
    ' 恢复Excel默认设置
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

优化说明（对应解决原问题） #

1. 消除重复声明：直接从OLE对象获取Word文档和对应应用实例，无需重复创建wdApp类对象，减少资源冲突。
2. 移除MsgBox依赖：通过关闭Excel与Word的提示弹窗，直接操作OLE对象的Object属性获取文档，彻底规避OLE操作等待问题，无需依赖弹窗延迟。
3. 避免Activate错误：跳过wdObj.Activate操作，直接调用OLE对象关联的Word文档，从根源解决错误1004。
4. 处理同名文件：添加文件存在性判断，提前清理同名文件（可改为重命名逻辑，比如追加时间戳），避免保存失败。
5. 修正逻辑顺序：先执行数据填充，再保存文档，符合正常业务流程，避免生成空白模板文件。
6. 真正后台执行：设置wdApp.Visible = False让Word在无界面模式运行，全程无弹窗干扰。

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