エクセルのマクロで質問です

質問

エクセルのマクロで質問です。

SaveAsを使って、あるセルの文字列をファイル名として保存する、というマクロを作りました。

取りあえずうまくいっているのですが、同じファイル名がすでに存在した場合、「上書きしますか？」というダイアログが出ます。

運用上、上書きは困るのですが、「いいえ」を選択するとマクロがエラーで止まってしまいます。

そこで、以下のどちらかの動作を実現するマクロは可能でしょうか？

1.いいえを選んだ時に、ファイル名を指定するダイアログに飛ぶ
2.同じファイル名があった場合、自動的に末尾に数字を不可して保存する（ファイル名.xlsがあった場合はファイル名2.xlsで保存する)

よろしくお願い致します。

回答No.1

hana-hana3 · ベストアンサー

DIR()関数でファイルの有無をチェック出来ます。

同名ファイルの存在を調べておく
http://officetanaka.net/excel/vba/file/file03.htm
ファイル作成保存時、同名のファイルが存在した時の処置
http://park7.wakwak.com/~efc21/cgi-bin/exqalounge.cgi?print+200807/08070082.txt

お礼

お礼が大変遅くなって失礼しました。
下の方のリンク先の内容が大変参考になりました。
ただ、そのまま実行するとファイル名が

**_1
**_1_2
**_1_2_3

と付加されてしまいましたので、若干の修正が必要でした。
が、結果的にこれでうまく行きました。
ありがとうございます！

回答No.2

pkh4989

以下の例を参考にしてください。

Sub 名前を付けて保存()
　　'
　　'
　　Flnm = "C:\TEST"
　　Do While ExitFlg = False
　　　　Flnm = Application.GetSaveAsFilename(InitialFileName:=Flnm, _
　　　　　　　　　　　　　filefilter:="Excel ファイル (*.xls), *.xls", Title:="名前を付けて保存")
　　　　If Flnm <> "False" Then
　　　　　　ExitFlg = True
　　　　End If
　　Loop
　　If Dir(Flnm) <> "" Then
　　　　'既に存在する場合は、ファイル名後ろに日付を付ける
　　　　Flnm = Left(Flnm, Len(Flnm) - 4) & Format(Now(), "yymmdd hhmmss") & ".xls"
　　End If
　　'ファイルを保存
　　ActiveWorkbook.SaveAs Filename:=Flnm
　　'
　　'
End Sub

お礼

ありがとうございます。
大変参考になりました。

お礼が遅くなって失礼しました(__)