«Объект не поддерживает это свойство или метод»

Question

Я пытаюсь создать макрос, который открывает все файлы .docx в указанной папке (и все подпапки) и заменяет текст, содержащийся в переменной «strFindText1», текстом в «strReplaceText1».

Я нашел пример кода в сети и адаптировал его по мере необходимости, но он выдает ошибку «Объект не поддерживает это свойство или метод» в строке «.HomeKey Unit: = wdStory». Я не могу найти решение. Пожалуйста, помогите мне.

Sub FindAndReplaceInFolder()
  Dim objDoc As Document
  Dim strFile As String
  Dim strFolder As String
  Dim strFindText As String
  Dim strReplaceText As String

  '  Pop up input boxes for user to enter folder path
  strFolder = InputBox("Enter folder path here:")
  strFile = Dir(strFolder & "\" & "*.docx", vbNormal)
  strFindText1 = "text_sample"
  strReplaceText1 = ActiveWorkbook.Sheets("Sheet1").Range("C2").Value

  '  Open each file in the folder to search and replace texts. Save and close the file after the action.
  While strFile <> ""
    Set objDoc = Documents.Open(Filename:=strFolder & "\" & strFile)
    With objDoc
      With Selection
        .HomeKey Unit:=wdStory
        With Selection.Find
          .Text = strFindText1
          .Replacement.Text = strReplaceText1
          .Forward = True
          .Wrap = wdFindContinue
          .Format = False
          .MatchCase = False
          .MatchWholeWord = False
          .MatchWildcards = False
          .MatchSoundsLike = False
          .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
      End With
      objDoc.Save
      objDoc.Close
      strFile = Dir()
    End With
  Wend
End Sub

Я должен указать, что я буду запускать макрос из файла Excel для изменения всех файлов Word.

Answer 1

Есть несколько проблем с вашим кодом. Например, вы указываете:

Dim objDoc As Document

но нет указания, используете ли вы раннее или позднее связывание; у вас даже нет строки, ссылающейся на приложение Word. Если бы вы использовали раннее связывание, я бы ожидал увидеть что-то вроде:

Dim wdApp As New Word.Application, wdDoc as Word.Document

Для позднего связывания я бы ожидал увидеть что-то вроде:

Dim objWord as Object, objDoc As Object

плюс код для создания экземпляра Word. Затем вы использовали бы:

Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile)

или

Set objDoc = objWord.Documents.Open(Filename:=strFolder & "\" & strFile)

в зависимости от ситуации.

Кроме того, ваш код обработки документов может быть улучшен. Например, вы можете заменить все:

With objDoc
  With Selection
    .HomeKey Unit:=wdStory
    With Selection.Find
      .Text = strFindText1
      .Replacement.Text = strReplaceText1
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
  End With
  objDoc.Save
  objDoc.Close

с:

With objDoc
  With .Range.Find
    .Text = strFindText1
    .Replacement.Text = strReplaceText1
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute Replace:=2 'wdReplaceAll
  End With
  .Close True
End With

Чтобы начать работу с кодом, попробуйте:

 Sub BulkFindReplace()
'Note: this code requires a reference to the Word object model.
'See under the VBE's Tools|References.
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim strFolder As String, strFile As String, StrFnd As String, StrRep As String
strFolder = GetFolder
If strFolder = "" Then Exit Sub
StrFnd = ActiveWorkbook.Sheets("Sheet1").Range("C2").Value
StrRep = ActiveWorkbook.Sheets("Sheet1").Range("D2").Value
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
  Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    With .Range.Find
      .Text = StrFnd
      .Replacement.Text = StrRep
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      .Execute Replace:=wdReplaceAll
    End With
    .Close SaveChanges:=True
  End With
  strFile = Dir()
Wend
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
End Function