VBA实现Excel文本复制到Word时随机运行报错的问题求助

• 无法定位代码行的无规律报错：属于Office跨应用COM跨进程调用的偶发异步故障，VBA编译器对这类由系统层（而非代码层）触发的错误不会绑定到具体执行行，所以调试模式无法跳转定位。触发这类错误的常见原因是Word进程响应超时、剪贴板被系统级进程抢占、窗口焦点切换导致应用激活状态丢失。
• .Paste行的随机报错：属于剪贴板机制的固有缺陷：
• 高频连续执行Range.Copy会把Excel内容写入系统公共剪贴板，剪贴板的保留时长、存储空间由系统动态管控，运行过程中如果有其他程序（输入法剪贴板、截图工具、办公软件自动同步）抢占剪贴板，原本复制的内容会被提前清空，执行粘贴时就会直接报错
• 原代码中所有Range引用没有绑定具体工作表，默认跟随当前激活的Excel窗口取值，运行中如果焦点跳转，会出现复制目标错位、复制失败的问题
• 连续复制操作没有主动释放剪贴板占用，Office会在复制后维持单元格的虚线选中状态，高频操作下会触发剪贴板内存保护机制，主动清空剪贴板内容

• 从交互逻辑上规避对系统剪贴板的依赖：直接读取单元格的文本值写入Word文档，完全消除.Paste环节的随机报错
• 补全所有Range的对象绑定，避免焦点切换导致的引用错位
• 增加COM连接的重试机制，处理Word进程偶发的响应超时问题
• 增加错误捕获逻辑，程序异常退出时自动清理残留的Word进程、释放剪贴板占用，避免下次运行时出现资源残留导致的报错

修改后的完整代码：

Sub CopyFromExcelToWordUsingCopyPaste()
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Dim myIndex As Integer
    Dim questionNumber As Integer
    Dim lastRow As Long
    Dim sourceSheet As Worksheet
    Dim retryCount As Integer
    
    ' 固定绑定数据源工作表，替换为你实际使用的工作表名称
    Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, 1).End(xlUp).Row
    questionNumber = 1
    
    ' 初始化Word进程，增加连接重试逻辑
    On Error Resume Next
    Set wrdApp = GetObject(, "Word.Application")
    retryCount = 0
    Do While wrdApp Is Nothing And retryCount < 3
        Set wrdApp = CreateObject("Word.Application")
        retryCount = retryCount + 1
    Loop
    On Error GoTo ErrorHandler
    
    wrdApp.Visible = True
    Set wrdDoc = wrdApp.Documents.Add
        
    ' 直接写入文本，不再依赖剪贴板复制粘贴
    For myIndex = 2 To lastRow
        With wrdDoc.ActiveWindow.Selection
            .TypeText questionNumber & ". " & sourceSheet.Range("A" & myIndex).Text
            .TypeParagraph
            
            .TypeText "a) " & sourceSheet.Range("B" & myIndex).Text
            .TypeParagraph
            .TypeText "b) " & sourceSheet.Range("C" & myIndex).Text
            .TypeParagraph
            .TypeText "c) " & sourceSheet.Range("D" & myIndex).Text
            .TypeParagraph
            
            questionNumber = questionNumber + 1
        End With
    Next
    
    ' 自动判断导出目录是否存在，避免保存路径报错
    If Dir("c:\Data\", vbDirectory) = "" Then MkDir "c:\Data"
    wrdDoc.SaveAs "c:\Data\testDocument.docx", FileFormat:=12
    wrdDoc.Close
    
    ' 正常退出时清理资源
    Set wrdDoc = Nothing
    wrdApp.Quit
    Set wrdApp = Nothing
    Exit Sub
    
ErrorHandler:
    ' 异常退出时清理占用的资源
    Application.CutCopyMode = False
    If Not wrdDoc Is Nothing Then wrdDoc.Close SaveChanges:=False
    If Not wrdApp Is Nothing Then wrdApp.Quit
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
    MsgBox "程序执行异常，错误码：" & Err.Number & "，错误描述：" & Err.Description
End Sub

• 如果需要保留单元格的原有格式，无法直接读取纯文本值的场景，需要在每次Range.Copy后加DoEvents等待系统完成剪贴板写入，粘贴完成后立刻执行Application.CutCopyMode = False释放剪贴板占用，不要连续高频操作剪贴板
• 运行程序前关闭第三方剪贴板管理工具、自动截图工具，避免这类程序后台抢占剪贴板内容
• 程序运行过程中不要手动点击切换Excel、Word窗口，避免应用焦点切换触发跨进程调用错误

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