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

时间:2017-07-10 15:11:10

标签: vba ms-word save rename

所以我需要重命名超过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:对象变量   或者未设置块变量

请帮我解决这个问题。

1 个答案:

答案 0 :(得分:0)

使用以下代码

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

使用Block in With块不能按预期工作,因为它总是采用第一个带块,然后第二个用。 删除其中一个,它将正常工作。