Question

我有大约700个不同的Word文档需要根据文本字符串重命名。每个单词docs的格式完全相同。

在doc这个词中，有一串文字说“你的企业名称0001 - Reno，NV”。 700个文档中的每一个都包含不同的位置名称。

我需要一个VBA宏，可以扫描每个word文档以找到该文本字符串，然后根据位置保存文档。因此，在这种情况下，文档应保存为：0001 - Reno，NV.docx

到目前为止我的代码是：

Sub Macro1()
Dim strFilename As String
Dim rngNum As Range
Dim fd As FileDialog
Dim strFolder As String
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
    .Title = "Select the folder that contains the documents."
    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 Doc = Documents.Open(strFolder & strDoc)
    With Doc
        Selection.HomeKey wdStory
        Selection.Find.ClearFormatting
        With Selection.Find
            Do While .Execute(FindText:="Your establishment name [0-9]{4}", MatchWildcards:=True, Forward:=True, Wrap:=wdFindStop) = True
                With Selection
                    Set rngNum = .Range
                    strFilename = Right(.Range.Text, 4)
                End With
            Loop
        End With
        .SaveAs strFolder & "Processed\" & strFilename
    End With
    strDoc = Dir$()
Wend
End Sub

此代码至少在理论上允许您选择存在所有700个文档的文件夹，然后创建一个名为“已处理”的新文件夹，然后放置所有新的重命名文档。

但是，当我运行代码时，我收到此错误：

Run time error '5152':
This is not a valid file name.
Try one or more of the following:
*Check the path to make sure it was typed correctly.
*Select a file from the list of files and folders.

Answer 1

我在测试时稍微修改了您的代码，以便于阅读，不确定错误的来源，但以下代码对我有用：

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 = "Select the folder that contains the documents."
    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

希望这有帮助， TheSilkCode

VBA宏读取Word文档，然后根据文件中的文本保存文档？

1 个答案: