みなさん、こんにちは！
タカハシ(@ntakahashi0505)です。
Word VBAで複数ファイルを一括処理するマクロの作り方についてお伝えしています。
前回の記事はこちらです。
ドキュメントを上書き保存する方法についてお伝えしましたね。
ただ、元のファイルを残したまま一括処理をしたい場合は、上書き保存だと困ってしまいます。
そんなときは、そう、名前を付けて保存ですね。
ということで、今回は、Word VBAで複数ファイルを処理して名前を付けて保存する方法をお伝えします。
では、行ってみましょう！
前回のおさらい
まずは前回のおさらいからです。
作成したプロシージャはこちらでした。
Sub openDocs()
Dim objFso As Object
Set objFso = CreateObject("Scripting.FileSystemObject")
Dim strPath As String
strPath = ThisDocument.Path & "\原稿\"
Dim obj As Object
For Each obj In objFso.getfolder(strPath).Files
With Documents.Open(strPath & "\" & obj.Name)
.Content.Font.Name = "Meiryo UI"
.Close wdSaveChanges
End With
Next obj
Set objFso = Nothing
End Sub
現在のマクロを記述するファイルと同階層にある「原稿」というフォルダ内の全てのファイルについて、フォントの種類を変更して上書き保存をするというものです。
14行目のCloseメソッドの引数にwdSaveChangesを設定していますので、閉じるときに上書き保存をします。
今回は、その箇所を名前を付けて保存に変更をしていきたいと思います。
SaveAs2メソッドで名前を付けて保存する
ドキュメントを名前を付けて保存する場合はSaveAs2メソッドを使います。
書き方はそうです。
ファイル名はパスを入れないと、既定のフォルダに保存されます。フルパスで指定するときが多いと思います。
では、以下プロシージャを実行してみましょう。
Sub openDoc()
Dim doc As Document
With Documents.Open(ThisDocument.Path & "\原稿（1章）.docx")
.Content.Font.Name = "Meiryo UI"
.SaveAs2 ThisDocument.Path & "\原稿（1章）修正.docx"
.Close
End With
End Sub
フォルダを除くと「原稿（1章）修正.docx」というファイル名で保存されていますね。
ドキュメントを開くと、同様にフォント変更がされているはずです。
SaveAs2メソッドの「2」の謎
ん？なんで「2」…？
と思うかも知れませんが、Word2010以降はSaveAs2メソッドになったそうです。2007以前はSaveAsメソッドです。
SaveAs2メソッドで追加された機能としては、保存するドキュメントの互換モードを指定する引数CompatibilityModeが指定できるようになった点で、ほかについては同様の機能です。
しかし、MSさんのセンス…。
複数ドキュメントの一括処理をして名前を付けて保存する
GetBaseNameメソッドでベースネームを取り出す
SaveAs2メソッドを使って、名前を付けて保存するとなると、別名を用意する必要がありますね。
「原稿（1章）.docx」を「原稿（1章）修正.docx」と変更するとして、2章の原稿も、3章の原稿も、同様に別名を生成をしていきたい場合に、どのようにすればよいでしょうか。
こんな時に便利なのが、FileSystemオブジェクトのGetBaseNameメソッドです。
GetBaseNameメソッドは指定したファイルやフォルダのベースネームつまり拡張子を除いたファイル名を取り出します。
「原稿（1章）.docx」であれば「原稿（1章）」がベースネームとなります。
書き方はこうです。
ただ、ベースネームを取り出すファイルのフルパスが必要になりますが、どう取得すればよいでしょうか。
FileオブジェクトのPathプロパティ
今回のプログラムでいうと、ベースネームを取り出すファイルは、For Each文内のobjという変数にFileオブジェクトとしてセットされます。
だからFileオブジェクトのフルパスを取得できればOKです。
FileオブジェクトにもPathプロパティがあります。
DocumentオブジェクトのPathプロパティは、ドキュメントが格納されているフォルダのフルパスでしたが、FileオブジェクトのPathプロパティはファイル名まで含めたフルパスを取得する点に注意下さい。
これで、各ファイルのベースネームが取得できるわけです。
複数ドキュメントを処理して名前を付けて保存するプロシージャ
これを元に、冒頭のプロシージャに修正を加えたのがこちらです。
Sub openDocs()
Dim objFso As Object
Set objFso = CreateObject("Scripting.FileSystemObject")
Dim strPath As String
strPath = ThisDocument.Path & "\原稿\"
Dim obj As Object
For Each obj In objFso.getfolder(strPath).Files
With Documents.Open(strPath & "\" & obj.Name)
.Content.Font.Name = "Meiryo UI"
.SaveAs2 strPath & objFso.getbasename(obj.Path) & "修正.docx"
.Close
End With
Next obj
Set objFso = Nothing
End Sub
今回の修正のメインは14行目ですね。
フォルダパスであるstrPathと各ファイルのベースネームに「修正.docx」を連結して、新しいファイル名を生成しています。
また、15行目のCloseメソッドはただ保存をすれば良いので、引数を削除しました。
実行すると、フォント種類が変更されたファイルたちは「～.修正.docx」 という別名で保存されます。
まとめ
Word VBAで複数ファイルを処理して名前を付けて保存する方法をお伝えしました。
名前を付けてドキュメントを保存するSaveAs2メソッドの使い方と、GetBaseNameメソッドによる別名の生成がポイントですね。
さて、次回ですが、各ファイルの処理についてもう少し凝った処理を加えていきたいと思います。
どうぞお楽しみに！
