マクロ VBA ファイル名を連番でつけたいのですが

マクロ初心者なので教えて頂けるとうれしいです。

保存先フォルダにファイル名を自動で名前をつけて保存させるところまでできたのですが、

保存先フォルダに同名フォルダがある場合に、
もともと指定しているファイル名のお尻に連番をつけていくようにしたいのですが・・・

例）
選択したシートをコピーして、
「A1+B1+見積書.xls」
という名前をつけて毎回保存していくのですが、
同名のファイルがある場合、
「A1+B1+見積書+1.xls」
「A1+B1+見積書+2.xls」
「A1+B1+見積書+3.xls」
　　　…というふうにお尻に自動で連番をつけて
保存できるようにしたいのです。

宜しくお願い致します！

No.1 回答者： fujillin 回答日時： 2009/05/13 11:09

ファイルの存在は　Dir関数でチェック可能です。

ソースがないので、文章の回答になりますが、
保存する前に　Dir(FilePath)でファイル名が返ってくれば、既にファイルが存在するので、名前を変更（+1、+2・・・）していって、存在しないファイル名になるまで繰り返してから、ファイルを保存すればよいでしょう。

詳しくは、Dirのヘルプを参照ください。

No.2 ベストアンサー 回答者： kigoshi 回答日時： 2009/05/13 11:31

おしりに付ける数字が１桁では9までしか付けられません。

9のあと10にすることも出来ますが、ファイル名でソートしたとき
見づらいと思います。
そこで数字を３桁、001,002,003....と付けていく例です。

Sub sample()
Dim fCount As Integer
Const outPath As String = "c:\temp\"
Dim kFileName As String

kFileName = Cells(1, 1).Value & Cells(1, 2).Value & "見積書"
If Dir(outPath & kFileName & ".xls") = "" Then
ActiveWorkbook.SaveAs (outPath & kFileName & ".xls")
Else
For fCount = 1 To 999
If Dir(outPath & kFileName & Right("00" & CStr(fCount), 3) & ".xls") = "" Then
ActiveWorkbook.SaveAs (outPath & kFileName & Right("00" & CStr(fCount), 3) & ".xls")
Exit For
End If
If fCount = 999 Then
MsgBox ("連番をこれ以上付けることが出来ません。")
End
End If
Next
End If
End Sub

この回答へのお礼

お礼が遅くなり申し訳ありません！
アレンジして使ってみたらうまくいきました！
ありがとうございました

お礼日時：2009/05/27 23:11