Question

我正在尝试运行搜索关键字的脚本，然后复制找到该关键字的整个句子，并将其粘贴到Excel电子表格中。

当我在1-2页的文档上运行脚本时，它运行正常，但是当我尝试更长的文档（100多页）时，我收到以下错误：

运行时错误“1004”：Worksheet类的粘贴方法失败。当我点击“debug”时，它说“objsheet.paste”就是问题。

你可以帮我修改一下代码，以便它可以处理更长的文本吗？

Sub FindWordCopySentence()
    Dim appExcel As Object
    Dim objSheet As Object
    Dim aRange As Range
    Dim intRowCount As Integer
    intRowCount = 1
    Set aRange = ActiveDocument.Range
    With aRange.Find
        Do
            .Text = "Hair"
            .Execute
            If .Found Then
                aRange.Expand Unit:=wdSentence
                aRange.Copy
                aRange.Collapse wdCollapseEnd
                If objSheet Is Nothing Then
                    Set appExcel = CreateObject("Excel.Application")
                                         Set objSheet = appExcel.workbooks.Open("C:\Users\HNR\Desktop\hair.xlsx").Sheets("Sheet1")
                    intRowCount = 1
                End If
                objSheet.Cells(intRowCount, 1).Select
                objSheet.Paste
                intRowCount = intRowCount + 1
            End If
        Loop While .Found
    End With
    If Not objSheet Is Nothing Then
        appExcel.workbooks(1).Close True
        appExcel.Quit
        Set objSheet = Nothing
        Set appExcel = Nothing
    End If
    Set aRange = Nothing
End Sub

Answer 1

如果问题是由于复制/粘贴信息，可以通过直接分配文本来避免：

Sub FindWordCopySentence()
    Dim appExcel As Object
    Dim objSheet As Object
    Dim aRange As Range
    Dim intRowCount As Integer
    Dim myTempText As String
    intRowCount = 1
    Set aRange = ActiveDocument.Range
    With aRange.Find
        Do
            .Text = "Hair"
            .Execute
            If .Found Then
                aRange.Expand Unit:=wdSentence
                'Store the text into a variable
                myTempText = aRange.Text
                aRange.Collapse wdCollapseEnd
                If objSheet Is Nothing Then
                    Set appExcel = CreateObject("Excel.Application")
                    Set objSheet = appExcel.workbooks.Open("C:\Users\HNR\Desktop\hair.xlsx").Sheets("Sheet1")
                    intRowCount = 1
                End If
                'Set the destination cell to the text we stored
                objSheet.Cells(intRowCount, 1).Value = myTempText
                intRowCount = intRowCount + 1
            End If
        Loop While .Found
    End With
    If Not objSheet Is Nothing Then
        appExcel.workbooks(1).Close True
        appExcel.Quit
        Set objSheet = Nothing
        Set appExcel = Nothing
    End If
    Set aRange = Nothing
End Sub

问题的另一个可能原因是，如果您在处理大型文档时感到无聊，那么您可以在后台运行时对其进行其他复制/粘贴操作。

Copy和Paste与其他应用程序共享剪贴板，因此，如果您在代码执行Copy之间和执行其Paste之间进行复制，则将尝试Paste复制的内容而非复制的内容。

因此，尽可能避免在代码中使用复制/粘贴。

宏错误 - Microsoft Word - 运行时错误“1004”：Worksheet类的粘贴方法失败

1 个答案: