将文档重命名为文档中的特定文本

Question

所以我有超过 800 个文档需要重命名。它们都包含一个名为“标题：”的特定部分。问题是，这出现在每个文档的不同位置。它基本上是之后的文本，我正在寻找它的名字。

Sub Macro1()
Dim strFolder As String
Dim strDoc As String
Dim wordApp As Word.Application
Dim wordDoc As Word.document

Set wordApp = New Word.Application
wordApp.Visible = True

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "D:\Test\"
If .Show = -1 Then
    strFolder = .SelectedItems(1) & "\"
Else
    MsgBox "You did not select the folder that contains the documents."
    Exit Sub
End If
End With

MkDir strFolder & "Processed"

strDoc = Dir$(strFolder & "*.docx")
While strDoc <> ""
Set wordDoc = Word.Documents.Open(strFolder & strDoc)
With wordDoc
    .Content.Select
    With wordApp.Selection.Find
        .Text = "Your establishment name [0-9]{4}"
        .MatchWildcards = True
        .wrap = wdFindStop
        .Execute
    End With
    .SaveAs strFolder & "Processed\" & Right(wordApp.Selection, 4) & ".docx"
    .Close
End With
strDoc = Dir$()
Wend

wordApp.Quit
Set wordApp = Nothing
End Sub

我发现了 Silkroad 完成的一些代码，看起来完全符合我的要求，但它出错了。

这基本上是在 WordApp.Selection.Find 行出错：

运行时错误 91：对象变量 或未设置块变量

请帮我解决问题。

Answer 1

使用下面的代码

With wordDoc
    .Content.Select
   'With wordApp.Selection.Find (Remove this line)
      ' Add the  wordApp.Selection.Find as below
    wordApp.Selection.Find.Text = "Your establishment name [0-9]{4}"
    wordApp.Selection.Find.MatchWildcards = True
    wordApp.Selection.Find.wrap = wdFindStop
    wordApp.Selection.Find.Execute
   End With  (Remove this line)
.SaveAs strFolder & "Processed\" & Right(wordApp.Selection, 4) & ".docx"
.Close
End With

With 块中的 With 块不能按预期工作，因为它总是先取第一个 with 块，然后再取第二个 with。 删除其中一个，它会正常工作。