从多个单词文档中查找和粘贴字符串无法完成（范围类的pastespecial方法失败）

Question

我有一个VBA宏，它打开文件夹中的每个word文档，并在文档中找到某个字符串，然后将其粘贴到打开的电子表格中。所有word文档都是相同的模板，并且包含有问题的字符串。

它适用于前4或5个文档然后我得到错误“范围类的pastespecial方法失败”。它失败的文档与其他文档没有任何不同，如果我删除了这个文档，那么它就失败了。有人可以帮忙吗？我是VBA的新手，所以我的代码很可能是垃圾。这是完整的代码：

Sub readForml()

Dim wdApp As New Word.Application
Dim myDoc As Word.Document
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim i As Integer
Dim myWkSht As Worksheet

wdApp.Visible = False
'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

 myExtension = "*.docx*"

Set myWkSht = ActiveSheet
myPath = "path_to_folder"
myFile = Dir(myPath & myExtension)
'set i to be furst blank row
i = myWkSht.Cells(myWkSht.Rows.Count, 1).End(xlUp).Row
'Loop through each Excel file in folder
  Do While myFile <> ""
     'Set variable equal to opened workbook
      Set myDoc = wdApp.Documents.Open(Filename:=myPath & myFile)
      DoEvents


With myDoc.Content

        .Find.ClearFormatting
        With .Find
            .Text = "number[0-9]{4}"
            .Format = False
            .MatchCase = True
            .MatchWholeWord = False
            .MatchWildcards = True
            .Execute
            End With
        .Copy
           myWkSht.Range("A" & i).PasteSpecial xlPasteValues


End With

      myDoc.Close SaveChanges:=False

    i = i + 1
    'Get next file name
      myFile = Dir()
    Loop

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

提前致谢”

Answer 1

此代码存在许多问题，可能会导致问题。我不确定是什么（或组合）是原因，但让我们看看......

1. 在VBA中，不应在同一行上声明和实例化对象。这在VB.NET中是可以的，但不是VBA。所以在一行中声明wdApp，但在另一行中声明Set wdApp = New Word.Application。
2. 使用特定的Range对象进行查找。目前，代码一方面告诉Word复制整个文档，但“找到”是搜索词 - 这对VBA来说很困惑。
3. 尝试将Set myDoc = Nothing放在Loop语句之前，以明确释放myDoc，然后再将下一个文档分配给它。
4. 通常最好测试是否实际找到了搜索到的术语。如果发生这种情况，不确定你想要发生什么，但是进行测试是件好事。

另请注意，注释不准确，代码不是循环Excel文件而是循环Word文件。这不会导致问题，但应该纠正以避免混淆。

Sub readForml()

Dim wdApp As Word.Application
Dim myDoc As Word.Document
Dim wdRange as Word.Range
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim i As Integer, bFound as Boolean
Dim myWkSht As Worksheet

Set wdApp = New Word.Application
wdApp.Visible = False
'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

 myExtension = "*.docx*"

Set myWkSht = ActiveSheet
myPath = "path_to_folder"
myFile = Dir(myPath & myExtension)
'set i to be first blank row
i = myWkSht.Cells(myWkSht.Rows.Count, 1).End(xlUp).Row
'Loop through each Excel file in folder
  Do While myFile <> ""
     'Set variable equal to opened workbook
      Set myDoc = wdApp.Documents.Open(Filename:=myPath & myFile)
      DoEvents

      Set wdRange = myDoc.Content
      With wdRange   
        .Find.ClearFormatting
        With .Find
            .Text = "number[0-9]{4}"
            .Format = False
            .MatchCase = True
            .MatchWholeWord = False
            .MatchWildcards = True
            bFound = .Execute
         End With
         If bFound Then
            .Copy
            myWkSht.Range("A" & i).PasteSpecial xlPasteValues
         Else
             MsgBox "Search term not found"
         End If
      End With

      myDoc.Close SaveChanges:=False
      Set myDoc = Nothing
      i = i + 1
      'Get next file name
      myFile = Dir()
    Loop

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub