VBA 自動保存方法

また質問に来ちゃいました。

VBAを使って自動保存にしたいんです。

同じタイトルになる場合上書きのアラートが出ると思うのですが、アラートを出さずに上書きをせず「タイトル_○○」というようなタイトルで保存はできるのでしょうか？

教えてください。

意味が解らないかもしれませんがこれが精一杯です；

ちなみに上書き処理をしないようにした場合

--------------------------------------
name = Format(Date, "ggge年m月分") & ".xls" '処理をした日の月で保存
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:= _
"C:\Documents and Settings\PC Users\デスクトップ\研修課題\" & name, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True

-----------------------------------------------------------

上のは給料明細を作成したときのものですが・・・
このときは上書き保存のアラートも出さず上書きもしないで保存されていたら処理終了にしたんです。

くどいようですが、アラートを出さずに上書きでもなく同じタイトルでも中身が違うという想定で「タイトル_○○」というような形にして別途保存したいです。
タイトルは処理した日の日付です。
本日であれば20081014という保存が最初にできると思いますが、保存した日に再度処理を行ったときに「20081014_2」とか「20081024_2」というようなタイトルにして保存をしたいんです。

意味が解らないかもしれませんがご指導のほどよろしくお願いします。

No.3 ベストアンサー 回答者： n-jun 回答日時： 2008/10/15 14:53

ファイル名が重複しないようにという解釈でテストしました。

適宜修正願います。

Sub test()
Dim Fname As String
Dim i As Integer

Fname = "R:\" & Format(Date, "ggge年m月分") & ".xls"
i = 1
Do

If Dir(Fname) = "" Then
ActiveWorkbook.SaveAs Filename:=Fname
Exit Do
Else
i = i + 1
Fname = "R:\" & Format(Date, "ggge年m月分") & "_" & i & ".xls"
End If
Loop

End Sub

この回答へのお礼

iってことは重複しないようにするための_○○の部分にあたりますよね？

解り安く試してみたいと思います。

もしバグったときは新しくスレ建てるのでそのときはよろしくお願いします。

お礼日時：2008/10/15 17:12

No.2 回答者： higekuman 回答日時： 2008/10/15 14:45

年月日をファイル名に使っていますが、いっそのこと時分秒までファイル名に使えば、重複は無くなりますよ。

さすがに1秒以内に2回保存するようなことは無いですよね。

この回答へのお礼

ありがとうございます。

その手があったんですね・・・

全く思いつかず・・・

確かに２回やるということはないですね。

ありがとうございました。

お礼日時：2008/10/15 17:11

No.1 回答者： pkh4989 回答日時： 2008/10/15 14:41

こんにちは。

参考にしてください。

Sub test()
　　Name = Format(Date, "ggge年m月分") & ".xls" '処理をした日の月で保存
　　If Dir(Name) <> "" Then
　　　　'存在の場合は、ファイル名に_○○を付ける
　　　　Name = Left(Name, Len(Name) - 4) & "_○○.xls"
　　End If
　　ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\PC Users\デスクトップ\研修課題\" & Flnm
End Sub

Sub 名前を付けて保存()
　　Flnm = "C:\TEST"
　　Flnm = Application.GetSaveAsFilename(InitialFileName:=Flnm, _
　　　　　　　　　　　filefilter:="Excel ファイル (*.xls), *.xls", Title:="名前を付けて保存")

　　If Flnm <> "False" Then
　　　　ExitFlg = True
　　End If
　　If Dir(Flnm) <> "" Then
　　　　Flnm = Left(Flnm, Len(Flnm) - 4) & Format(Now(), "_yymmdd hhmmss") & ".xls"
　　End If
　　ActiveWorkbook.SaveAs Filename:=Flnm
End Sub

この回答へのお礼

参考にさせていただきます！！

わかりづらい説明をしてしまったかと指摘されるのではないかとひやひやしましたが丁寧に教えてくださってありがとうございます。

ためさせていただきます。

またなにかありましたらご指導ください！！

お礼日時：2008/10/15 17:09