VBAを使って名前をつけて保存をしたい

質問

例えばデーター管理ファイルＡというファイルの中にある
顧客データという名前のエクセルブックを開いて上書き保存をして、
データー管理ファイルＢというファイルの中に顧客データ【1016】(1)
という名前で(1016とは本日の日付を表しています)保存するとします。

この段階で、ファイルＢの中に顧客データ【1016】(1)が入ってる事になりますが、再度本日二回目にＡファイルの中にある顧客データをBファイルの中へ保存する場合顧客データ【1016】(2)という名称で保存して

さらに本日三回目に同じように保存する場合は【1016】(3)というようにしたいのですが(もし明日保存する場合は、一回目は顧客データ【1017】(1)、二回目は【1017】(2)というように日付が変わると(1)から始めるようにしたいのですが)、VBAでどの様にしたらいいでしょうか?

回答No.3

pkh4989 · ベストアンサー

こんにちは。
以下の例を参考にしてください。

>【1016】(2)という名称で保存して
→ブック名称の事ですよね？

Sub 名前を付けて保存()
　　Dim wSeq　　　　As String
　　Dim wStr　　　　As String
　　Dim Flnm　　　　As String
　　Dim wFlnm　　　 As String
　　'
　　Flnm = "C:\" & Format(Date, "mmdd") & ".xls"
　　Flnm = Application.GetSaveAsFilename(InitialFileName:=Flnm, _
　　　　　　　　　　　filefilter:="Excel ファイル (*.xls), *.xls", Title:="名前を付けて保存")

　　If Flnm = "False" Then
　　　　Exit Sub
　　End If
　　'
　　wSeq = 0
　　ExitFlg = False
　　wFlnm = Flnm
　　Do While ExitFlg = False
　　　　If Dir(Flnm) <> "" Then
　　　　　　'存在したら、連番を加算
　　　　　　wSeq = wSeq + 1
　　　　　　wStr = "(" & wSeq & ")"
　　　　　　Flnm = Left(wFlnm, Len(wFlnm) - 4) & wStr & ".xls"
　　　　Else
　　　　　　'存在しない時、保存
　　　　　　ActiveWorkbook.SaveAs Filename:=Flnm
　　　　　　ExitFlg = True
　　　　End If
　　Loop
End Sub

補足

素人なのでよく分らないんですが、C:\Documents and Settings\AABBセンター\デスクトップ\データー管理にフォルダAとフォルダBが入ってます。C:\Documents and Settings\AABBセンター\デスクトップ\データー管理\ファイルAに顧客データというエクセルブックが入ってます。その場合上記のコードのどこを書き換えればいいでしょうか？　無知ですいませんが、教えて下さい。

回答No.6

imogasi

質問の中の用語で、ファイルの中にファイルを作る、といった書き方があり、無茶です。
訂正して、フォルダ（名）のことかはっきりさせること。
マクロの記録でもとって、ここをこう修正したいですが、ぐらいの質問にすべきと思うが。
マクロの記録ぐらいとって勉強すること。

回答No.5

pkh4989

以下のマクロは、既に開いたブックに対して保存する部分のみです。
「ファイルB\」の方に保存するとしたら、以下のように変更してください。
「ファイルA\」の方から「顧客データ.xls」を開いた状態で、以下のマクロを実行してみてください。
「名前を付けて保存」する画面が表示されるので、保存先、ファイ名などの変更も出来ます。
そのまま、「保存」ボタンを押すと、指定されたフォルダ、ファイル名称で保存されます。
あくまで、例なので細かい部分などは自分で変更する必要があります。

Sub 名前を付けて保存()
　　Dim wSeq　　　　As String
　　Dim wStr　　　　As String
　　Dim Flnm　　　　As String
　　Dim wFlnm　　　 As String
　　'
　　Flnm = "C:\Documents and Settings\AABBセンター\デスクトップ\データー管理\ファイルB\"　'←保存先フォルダ
　　Flnm = Flnm & "顧客データ"　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　'←保存ファイル名
　　Flnm = Application.GetSaveAsFilename(InitialFileName:=Flnm, _
　　　　　　　　　　　filefilter:="Excel ファイル (*.xls), *.xls", Title:="名前を付けて保存")

　　If Flnm = "False" Then
　　　　Exit Sub
　　End If
　　'
　　wSeq = 0
　　ExitFlg = False
　　wFlnm = Flnm
　　Do While ExitFlg = False
　　　　If Dir(Flnm) <> "" Then
　　　　　　'存在したら、連番を加算
　　　　　　wSeq = wSeq + 1
　　　　　　wStr = "(" & wSeq & ")"
　　　　　　Flnm = Left(wFlnm, Len(wFlnm) - 4) & wStr & ".xls"
　　　　Else
　　　　　　'存在しない時、保存
　　　　　　ActiveWorkbook.SaveAs Filename:=Flnm
　　　　　　ExitFlg = True
　　　　End If
　　Loop
End Sub

お礼

試行錯誤の結果、自分の思うようなものが出来ました　ご回答本当に助かりました　有難うございました

回答No.4

pkh4989

No3です。
以下のように変更してください。

　　Flnm = "C:\" & Format(Date, "mmdd") & ".xls"
　　↓
　　Flnm = "C:\Documents and Settings\AABBセンター\デスクトップ\データー管理\ファイルA\"
　　Flnm = Flnm & "顧客データ"

補足

すいません
C:\Documents and Settings\AABBセンター\デスクトップ\データー管理\ファイルA\→C:\Documents and Settings\AABBセンター\デスクトップ\データー管理\フォルダA\でした(ここに顧客データという名前のエクセルブックが入ってます)
それで五行目の"C:\"の部分を→"C:\Documents and Settings\AABBセンター\デスクトップ\データー管理\フォルダA\"に書き換えるのはわかりますが、Flnm = Flnm & "顧客データ"　の部分はどの部分を書き換えてるのわかりません。あと顧客データをC:\Documents andSettings\AABBセンター\デスクトップ\データー管理\フォルダB\に最初に説明したやり方で名前を変えて保存していくわけですが、後はもうコードを書き換える必要は無くそのままモジュールにコードを貼り付けて実行できますでしょうか？

回答No.2

mt2008

「データー管理ファイルＡというファイル」「データー管理ファイルＢというファイル」とありますが、これはフォルダの事だと理解しました。
つまり、『データー管理ファイルＢ』と言うフォルダに、日付と連番を使ったユニークなファイル名でファイルを保存したいということでよろしいでしょうか？

ファイル名を確定する部分だけ。
まず、ファイル名を作り、Dir関数で同名ファイルの有無を調べます。
同名ファイルが有れば連番を+1して再確認、無ければこの後でそのファイル名を使用します。

nCount = 0　'連番用
sFilenameD = "【" & Format(Now(), "MMDD") & "】(" 'ファイル名の日付を含んだ前の部分
Do　'ループ開始
　nCount = ncount + 1
　sFilename = sFilenameD & nCount & ").xls" 'ファイル名
　sRtn = Dir("C:\データー管理ファイルＢ\" & sFilename) '上で作成したファイル名と同じファイルがあるか
Loop Until sRtn = "" 'ファイル名未使用ならループを抜ける

回答No.1

sirochacha

＞VBAでどの様にしたらいいでしょうか?
これはVBAでプログラムを作成して欲しいと言うことなのでしょうか
そうだとしたら規約違反の「丸投げに相当します」ので回答できません

質問者様ご自身でプログラムを作成したいと言う事でしたら
excel　VBA　保存
などの語句を検索すればプログラム作成の参考となるHPがいくつも出てきますよ