同名ファイルを保存するときの処理をパーツ化する
今回は、マクロ内で同名ファイルを保存するときに、
上書きorSaveキャンセルor名前の変更
を選択できるようにMsgBoxで呼びかけるマクロを作っていきます。
ではまずはコードから。
Sub save_same_filename(file_fullname As String) 'MsgBoxを用いて、同名ファイルがあったときに、 '上書きorSaveキャンセルor名前の変更 'を選択し、場合によっては処理がループするようにする
Dim flag As Boolean, file_name As String, folder_path As String, _ result As VbMsgBoxResult, fso As Object, i As Long, _ u_target As Long, file_extension As String
Set fso = CreateObject("Scripting.FileSystemObject")
file_name = fso.GetBaseName(file_fullname) folder_path = fso.GetParentFolderName(file_fullname) file_extension = fso.GetExtensionName(file_fullname)
Do While Not flag If fso.FileExists(file_fullname) Then '同名ファイルが存在したら result = MsgBox( _ "同じファイル名のファイルがあります。上書きしますか？", _ Buttons:=vbYesNo) If result = vbYes Then '上書きするなら終了 flag = True Else '上書きしないなら result = MsgBox( _ "ファイル名を変更しますか？", _ Buttons:=vbYesNo) If result = vbYes Then 'ファイル名を変更するなら file_name = InputBox("ファイル名を入力してください", _ , file_name) If file_name = "" Then End 'キャンセルか空白入力で終了 file_fullname = folder_path & "\" & file_name & "." & file_extension Else 'ファイル名を変更しないなら終了 Exit Sub End If End If Else '同名ファイルが存在しなかったら終了 flag = True End If Loop
End Sub
ポイントは前回紹介したScripring.FileSystemObjectを使う方法です。
あとは、このマクロを呼びだしたマクロも終了する「End」。
flagはループから逃げるために用意しましたが、End subとかExit Doでもよかったですね。
ということで、詳しい説明は省きますが、こんな感じです（投げやり）。
