Excel数据复制到Word书签：合并代码后打开新文档崩溃问题

核心崩溃原因 #

代码前半段完成模板另存后，已经执行了WordApp.Quit和Set WordApp = Nothing，销毁了Word应用对象。但后半段操作新文档时，依然试图通过WordApp访问文档和选择对象，这属于无效对象引用，直接触发崩溃。

其他问题点 #

• 重复创建Word实例，造成资源冗余
• 错误处理语句位置错误，无法覆盖关键操作步骤
• 表格粘贴使用纯文本格式，丢失原有表格结构

修正后的完整代码 #

Sub TrialFour()
    Dim WordApp As Object, WordDocu As Object, path As String
    Dim fileSaveName As Variant, FileToOpen As Variant
    Dim wDoc As Object
    
    ' 错误处理提前，覆盖全流程
    On Error GoTo ErrorHandler

    ' 选择Word模板
    MsgBox "Please Select the CF Word Template"
    With Application.FileDialog(msoFileDialogOpen)
        .Show
        If .SelectedItems.Count = 1 Then
            path = .SelectedItems(1)
        End If
    End With
    If path = "" Then Exit Sub

    ' 创建Word实例并打开模板
    Set WordApp = CreateObject("Word.Application")
    Set WordDocu = WordApp.Documents.Open(path)
    WordApp.Visible = False

    ' 另存为新文档
    MsgBox "Select the location for where the CF Document should be saved and name it for the Site"
    fileSaveName = Application.GetSaveAsFilename( _
        fileFilter:="Word Documents (*.docx), *.docx")
    If fileSaveName = False Then
        WordDocu.Close False
        WordApp.Quit
        Set WordDocu = Nothing
        Set WordApp = Nothing
        Exit Sub
    End If
    WordDocu.SaveAs2 Filename:=fileSaveName, FileFormat:=16 ' wdFormatDocumentDefault对应值16，避免未引用Word库的错误
    WordDocu.Close False

    ' 直接打开刚保存的文档，无需重新选择（如果必须手动选择可保留原选择逻辑）
    Set wDoc = WordApp.Documents.Open(fileSaveName)
    WordApp.Visible = True

    ' 粘贴站点名称到书签位置
    ThisWorkbook.Worksheets(Sheet1.Name).Range("A6").Copy
    With wDoc.Bookmarks("Site_Name").Range
        .PasteAndFormat 2 ' wdFormatPlainText对应值2
        ' 保留书签（粘贴后书签会消失，重新添加）
        wDoc.Bookmarks.Add "Site_Name", .Duplicate
    End With

    ' 粘贴表格到书签位置，保留表格格式
    ThisWorkbook.Worksheets(Sheet3.Name).ListObjects("Building_List").Range.Copy
    With wDoc.Bookmarks("Building_List").Range
        .PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
        wDoc.Bookmarks.Add "Building_List", .Duplicate
    End With

    ' 清理剪贴板
    Application.CutCopyMode = False

    ' 收尾
    Set wDoc = Nothing
    Set WordDocu = Nothing
    Set WordApp = Nothing
    Exit Sub

ErrorHandler:
    ' 出错时确保Word实例被关闭
    If Not WordDocu Is Nothing Then
        WordDocu.Close False
        Set WordDocu = Nothing
    End If
    If Not WordApp Is Nothing Then
        WordApp.Quit
        Set WordApp = Nothing
    End If
    MsgBox "An error occurred: " & Err.Description, vbCritical, "Error"
End Sub

关键优化说明 #

1. 复用Word实例：全程使用同一个Word应用对象，避免频繁启停，同时解决无效引用问题
2. 错误处理覆盖全流程：将错误处理语句放在开头，确保所有操作步骤都能被捕获
3. 表格粘贴优化：使用PasteExcelTable方法保留表格结构，替代纯文本粘贴
4. 保留书签：粘贴内容会覆盖书签，添加代码重新创建书签，方便后续操作
5. 避免常量依赖：直接使用wdFormatDocumentDefault和wdFormatPlainText对应的数值，无需引用Word对象库

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