ファイル名を変えて保存する[Word] - 素人がExcelVBAによる「一人働き方改革」に挑むブログ

Wordドキュメントの名前を変えて保存する

SaveAs2メソッドとNameステートメントの処理をラップする

イメージとしては、

「名前を付けて保存」でファイル名を変えて別フォルダに移す処理
元のファイルを別のフォルダに移す処理

をいっぺんにやってしまう、という感じ。

コード

次のようなSubを作った。

リスト１　標準モジュール

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)

は引数の設定。

第１引数は、当該のDocumentオブジェクト。

第２引数は、新しいファイルネーム。

第３引数は、リネーム後ファイルの保存先。フォルダパスを文字列で渡す。

第４引数は、元ファイルの保存先。省略可にしてあって、省略されたら、後で第１引数targetDocumentのあるフォルダを指定するようにする。

(2)の

If Right(destinationOfNewFile, 1) <> "\" Then _
  destinationOfNewFile = destinationOfNewFile & "\"

では、引数で渡されたフォルダパスの文字列の右端に「\」を追加。念のため、もともと右端が「\」だったら何もしないようにしてある。

(3)の

If IsMissing(destinationOfOriginalFile) Then _
  destinationOfOriginalFile = targetDocument.Path
If Right(destinationOfOriginalFile, 1) <> "\" Then _
  destinationOfOriginalFile = destinationOfOriginalFile & "\"

では、まず第４引数が省略されている場合にdestinationOfOriginalFileにtargetDocumentのあるフォルダパスをぶち込んでから、(2)と同じように右端に「\」を追加。

(4)からの６行がメインの処理第一弾で、名前を付けて保存し、ドキュメントを閉じるところまで。

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

で元のファイルの場所を変更しておしまい。

実験

f:id:akashi_keirin:20180204205121j:plain

このフォルダ内の「35期中野　浩一.docx」を開いて、

f:id:akashi_keirin:20180204205128j:plain

アクティブにしておいて、次のコードを実行する。

リスト２　標準モジュール

Public Sub testRenameFile()
  Dim doc As Document
  Set doc = ActiveDocument
  Call renameFile(targetDocument:=doc, _
                  newFileName:="ち～んｗ.docm", _
                  destinationOfNewFile:=doc.Path & "\Renamed", _
                  destinationOfOriginalFile:=doc.Path & "\backup")
End Sub

アクティブドキュメントを変数docにぶち込んで、リスト１のrenameFileを呼び出しているだけ。