複数のWORDを一括置換

複数のWord文書に対して文字列置換こちらのサイトのマクロを使ってみた
WORDにマクロとして登録したら動いた

WORD

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40

Sub 複数文書連続処理_文字列置換()     '置換文字列の指定     mae = InputBox("置換前の文字列を入力してください。", "置換前")     If mae = "" Then Exit Sub     ato = InputBox("置換後の文字列を入力してください。", "置換後")     If ato = "" Then Exit Sub     'フォルダの選択     With Application.FileDialog(msoFileDialogFolderPicker)         .Title = "フォルダを選択"         .AllowMultiSelect = False         If .Show = -1 Then             mypath = .SelectedItems(1) & "\"         Else             MsgBox "終了します。"             Exit Sub         End If     End With     '実行     res = MsgBox(mypath & "のフォルダ内のWord文書について「" & mae & "」を「" & ato & "」に置換します。よろしいですか。", vbOKCancel)     If res = vbCancel Then Exit Sub     myfile = Dir(mypath & "*.doc*")     Do While myfile <> ""         Documents.Open FileName:=mypath & myfile         Call 文書全体を置換(mae, ato)         ActiveWindow.Close SaveChanges:=wdSaveChanges         myfile = Dir     Loop End Sub Function 文書全体を置換(mae, ato)     Set myRange = ActiveDocument.Range(Start:=0, End:=0)     With myRange.Find         .ClearFormatting         .Text = mae         With .Replacement             .ClearFormatting             .Text = ato         End With         .Execute Replace:=wdReplaceAll     End With End Function

VBS版もこちらで紹介されていた。WORDをドロップすると置換してくれるらしい。

WORD

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43

' 置き換え対象文字列。 strSrc→strDst へ一括置換します。 strDst = "aaaaaa" strSrc = "bbbbbb"   ' 引数の配列をargsに獲得する Set args = Wscript.Arguments   ' ワードを起動する Set objWord = CreateObject("Word.Application") objWord.Visible = True   ' args のファイル名たちを順番に FileName へ入れて全ファイル分ループする For Each FileName in args       ' フルパスを元にファイルを開く     Set objDoc = objWord.Documents.Open( FileName )     Set objSelection = objWord.Selection       ' 検索文字列をサーチ     objSelection.Find.Text = strSrc     objSelection.Find.Forward = TRUE     objSelection.Find.MatchWholeWord = TRUE       ' 発見したら置換     objSelection.Find.Replacement.Text = strDst     objSelection.Find.Execute ,,,,,,,,,,2       ' 終わったら同じフルパスに対して上書き保存     objDoc.SaveAs FileName       ' ファイルを閉じる     objDoc.Close       ' 各種オブジェクトの解放     Set objSelection = Nothing     Set objDoc = Nothing   Next   ' ワードを終了する objWord.Quit Set objWord = Nothing Set args = Nothing