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

Question

因此，我有800多份文件需要重新命名。它们都包含一个名为“title：”的特定部分。问题是，在每个文档中，这都会出现在不同的地方。这基本上是文本之后，我想要命名它。

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块。去掉其中的一个，它就能正常工作了。