Word文書を読み取り、ファイルにテキストに基づいて文書を保存するVBAマクロ？

Question

私は約700の異なるWord文書をテキスト文字列に基づいて名前を変更する必要があります。 docという単語の形式はまったく同じです。

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のドキュメントが存在し、次に「Processed」という名前の新しいフォルダが作成され、新しい名前のドキュメントがすべて配置されます。

はしかし、私は、コードを実行したとき、私はこのエラーが表示されます。

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