Wordドキュメントの名前を変えて保存する
SaveAs2メソッドとNameステートメントの処理をラップする
イメージとしては、
- 「名前を付けて保存」でファイル名を変えて別フォルダに移す処理
- 元のファイルを別のフォルダに移す処理
をいっぺんにやってしまう、という感じ。
コード
次のようなSubを作った。
リスト1 標準モジュール
Public Sub renameFile( _ ByVal targetDocument As Document, _ ByVal newFileName As String, _ ByVal destinationOfNewFile As String, _ Optional ByVal destinationOfOriginalFile As String) '……(1)' If Right(destinationOfNewFile, 1) <> "\" Then _ destinationOfNewFile = destinationOfNewFile & "\" '……(2)' If IsMissing(destinationOfOriginalFile) Then _ destinationOfOriginalFile = targetDocument.Path '……(3)' If Right(destinationOfOriginalFile, 1) <> "\" Then _ destinationOfOriginalFile = destinationOfOriginalFile & "\" Dim originalFileFullName As String Dim originalFileName As String With targetDocument '……(4)' originalFileFullName = .FullName '……(5)' originalFileName = .Name '……(6)' .SaveAs2 FileName:=destinationOfNewFile & newFileName '……(7)' .Close SaveChanges:=False '……(8)' End With Name originalFileFullName As _ destinationOfOriginalFile & originalFileName '……(9)' End Sub
汎用性を意識して、ちょっと長くなった。
(1)の
Public Sub renameFile( _ ByVal targetDocument As Document, _ ByVal newFileName As String, _ ByVal destinationOfNewFile As String, _ Optional ByVal destinationOfOriginalFile As String)
は引数の設定。
第1引数は、当該のDocumentオブジェクト。
第2引数は、新しいファイルネーム。
第3引数は、リネーム後ファイルの保存先。フォルダパスを文字列で渡す。
第4引数は、元ファイルの保存先。省略可にしてあって、省略されたら、後で第1引数targetDocumentのあるフォルダを指定するようにする。
(2)の
If Right(destinationOfNewFile, 1) <> "\" Then _ destinationOfNewFile = destinationOfNewFile & "\"
では、引数で渡されたフォルダパスの文字列の右端に「\」を追加。念のため、もともと右端が「\」だったら何もしないようにしてある。
(3)の
If IsMissing(destinationOfOriginalFile) Then _ destinationOfOriginalFile = targetDocument.Path If Right(destinationOfOriginalFile, 1) <> "\" Then _ destinationOfOriginalFile = destinationOfOriginalFile & "\"
では、まず第4引数が省略されている場合にdestinationOfOriginalFileにtargetDocumentのあるフォルダパスをぶち込んでから、(2)と同じように右端に「\」を追加。
(4)からの6行がメインの処理第一弾で、名前を付けて保存し、ドキュメントを閉じるところまで。
With targetDocument originalFileFullName = .FullName '……(5)' originalFileName = .Name '……(6)' .SaveAs2 FileName:=destinationOfNewFile & newFileName '……(7)' .Close SaveChanges:=False '……(8)' End With
まず(5)の
originalFileFullName = .FullName
で、変数originalFileFullNameに引数で渡されたtargetDocumentのフルパスをぶち込み、
(6)の
originalFileName = .Name
で変数originalFileNameにtargetDocumentのファイル名(拡張子付き)をぶち込む。
ここまで準備をしておいて、(7)の
.SaveAs2 FileName:=destinationOfNewFile & newFileName
でリネームしてdestinationOfNewFileで指定したフォルダに保存し、
(8)の
.Close SaveChanges:=False
で保存せずに閉じる。
ここで閉じておかないと、次のNameステートメントの実行でエラーになる。
後は、(9)の
Name originalFileFullName As _ destinationOfOriginalFile & originalFileName
で元のファイルの場所を変更しておしまい。
実験
このフォルダ内の「35期 中野 浩一.docx」を開いて、
アクティブにしておいて、次のコードを実行する。
リスト2 標準モジュール
Public Sub testRenameFile() Dim doc As Document Set doc = ActiveDocument Call renameFile(targetDocument:=doc, _ newFileName:="ち~んw.docm", _ destinationOfNewFile:=doc.Path & "\Renamed", _ destinationOfOriginalFile:=doc.Path & "\backup") End Sub
アクティブドキュメントを変数docにぶち込んで、リスト1のrenameFileを呼び出しているだけ。
実行結果
元のフォルダはこの通り。「35期 中野 浩一.docx」がなくなっている。
Renamedフォルダの中身は、
この通り。
んで、backupフォルダの中身は、
この通り。意図したとおりの結果となった。
おわりに
これで、
こいつと合わせると便利なアドインができるっぽい。