Макрос VBA, который читает документ Word, а затем сохраняет документ на основе текста в файле?

Question

У меня около 700 различных документов Word, которые нужно переименовать на основе текстовой строки. Формат каждого слова docs точно такой же.

В слове doc есть строка текста, в которой говорится: «Ваше имя заведения 0001 - Reno, NV». Каждый из 700 документов содержит другое название местоположения.

Мне нужен макрос VBA, который может сканировать каждое из этих словных документов, чтобы найти эту текстовую строку, а затем сохранить документ в соответствии с тем, что находится в этом месте. Таким образом, в данном случае, документ должен быть сохранен как: 0001 - Рено, 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