『エラー1004の回避』（PHL） よろしくお願いします。 2022年11月23日なら221123のようにsheet3のG10に日付を入力します。 同じ日付を入力した場合、 ThisWorkbook.SaveAs Cur_Path & "\" & New_Name でエラー1004が発生します。 同じ日付が入力された場合メッセージボックスで 「同じ日付があるので違う日付を入力してください」 と表示するにはどうしたらよいのでしょうか。 Option Explicit Sub 保存() Dim Cur_Path As String 'ファイルのパス Dim Cur_Name As String '元のファイル名 Dim New_Name As String '変更後のファイル名 Dim G10V As String 'G10の値 G10V = Sheet3.Range("G10") 'ファイルのパス、ファイル名の読み込み Cur_Path = ThisWorkbook.Path Cur_Name = ThisWorkbook.Name New_Name = "作業日報-" & G10V & "（" & Worksheets("作業").Range("V1").Value & "）" & ".xlsm" 'ファイルの別名保存して閉じて再度開く ThisWorkbook.SaveAs Cur_Path & "\" & New_Name Workbooks.Open Cur_Path & "\" & New_Name 'ファイルの別名保存して閉じて再度開く If Cur_Path & "\" & New_Name <> Cur_Path & "\" & Cur_Name Then Kill Cur_Path & "\" & Cur_Name Else End If End Sub ＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞ ---- ↑正常作動いたしておりますです。 置き換え確認ポップでキャンセルを選択した場合にでる エラーの事でせうか m(__)m （隠居Z） 2022/11/23(水) 11:13:53 ---- 隠居Zさん 置き換え確認ポップでキャンセルを選択した場合にでる エラーの事でせうか そうです 状況の説明不足で申し訳ありませんでした （PHL） 2022/11/23(水) 11:17:03 ---- おはようございます＾＾ 一案ですが Dirステートメント とか ファイルシステムオブジェクト とかを使用して､先に保存予定ファイル名と同名のファイルの有無 を確認されては､どうでしょうか｡ 又は On Error GoTo line: とかでエラー処理とか。。。(￣▽￣) Workbooks.Open Cur_Path & "\" & New_Name は、既にカレントブックなので要らないのではないでしょうか。 要らぬお世話でしたら、お許しを＾＾； m(__)m （隠居Z） 2022/11/23(水) 11:23:57 ---- If Dir(Cur_Path & "\" & New_Name) = "" Then ThisWorkbook.SaveAs Cur_Path & "\" & New_Name Else MsgBox "同じ日付があるので違う日付を入力してください" Exit Sub End If みたいな、感じでせうか。。。＾＾； m(__)m （隠居Z） 2022/11/23(水) 11:48:54 ---- 同じ日付てもRange("V1").Valueの値によってはエラーは出ませんね。 これも考慮する必要があるのではないでしょうか。 作業日報-20221123（3） 作業日報-20221123（AA） （???） 2022/11/23(水) 11:51:21 ---- Cur_Name と New_Name がイコールのときは上書き保存でもいいのでないか？ （トォーリス・ガリ） 2022/11/23(水) 12:08:40 ---- ---- ???さん　のご指摘の通りかと すみません。有難う御座いました。m(__)m ちょい、考えてみます。(#^^#)ｖ でわ （隠居Z） 2022/11/23(水) 12:51:06 ---- ■１ ＞2022年11月23日なら221123のようにsheet3のG10に日付を入力します。 ↑を普通に【日付型】の値を入力するのではだめなのですか？ そうすれば↓のようにFormat関数で臨む文字列が得られるのでは？ Sub テキトー() With Range("A1") .Formula = "=TODAY()" MsgBox Format(.Value, "YYMMDD") End With End Sub ■２ ＞同じ日付が入力された場合メッセージボックスで〜 既に提案があるように、同名ファイルがあるかどうかチェックすればよいと思います。 ■３ 興味本位で聞きますが↓の狙いは何ですか 'ファイルの別名保存して閉じて再度開く ThisWorkbook.SaveAs Cur_Path & "\" & New_Name Workbooks.Open Cur_Path & "\" & New_Name （もこな２） 2022/11/23(水) 16:32:22 ---- ばんわ〜＾＾。既に、別案がご案内ですが、被りましたので そのまま。。。m(__)ｖ/// Sub 保存() Dim Cur_Path As String 'ファイルのパス Dim Cur_Name As String '元のファイル名 Dim New_Name As String '変更後のファイル名 Dim G10V As String 'G10の値 Dim Chk_Fnm As String Dim tmp G10V = Sheet3.Range("G10") 'ファイルのパス、ファイル名の読み込み Cur_Path = ThisWorkbook.Path Cur_Name = ThisWorkbook.Name New_Name = "作業日報-" & G10V & "（" & Worksheets("作業").Range("V1").Value & "）" & ".xlsm" 'ファイルの別名保存して閉じて再度開く Chk_Fnm = Dir(Cur_Path & "\" & "*.xlsm") tmp = Replace(StrConv(Chk_Fnm, vbNarrow), "-", Chr(32)) tmp = Replace(StrConv(tmp, vbNarrow), "(", Chr(32)) tmp = Replace(StrConv(tmp, vbNarrow), ")", Chr(32)) tmp = Split(tmp, Chr(32)) Select Case UBound(tmp) Case -1, 0 ThisWorkbook.SaveAs Cur_Path & "\" & New_Name Case 3 If G10V = tmp(1) Then MsgBox "同じ日付があるので違う日付を入力してください" Erase tmp Exit Sub End If End Select If Cur_Path & "\" & New_Name <> Cur_Path & "\" & Cur_Name Then Kill Cur_Path & "\" & Cur_Name Else End If End Sub みたいな感じかな。。。＾＾。-1　はあり得ないかも。。。；(￣▽￣) このフォルダ内に、常に一つしかブックが無い場合対応です 別名保存すると、全ファイルは消し去っているので多分これで行けるかも 複数、貯めるなら、別途、工夫が必要かと。 （隠居Z） 2022/11/23(水) 16:47:14 ---- 隠居Zさん ありがとうございます。 後で試します。 ???さん そうです、G10とV1の二つの値で名前をつけているので 同じ名前になるということが全くないとは言えませんが、 特殊な場合を除いてほぼありません。 なので、このままでもいいのかなと質問した後思いました。 トォーリス・ガリさん Cur_Nameは常に作業日報nnnnnn（V1の値).xlsm New_Nameは作業日報221123(V1の値).xlsm です もこな２さん 1 221123の後に追い番号をつけます 　例　221123−1、221123−2 　それなので日付だとうまくできないと思います 2 Dirを使うのですよね 　調べてみます 3 https://my-tax-nology.com/excel-vba-changing-file-name-while-file-opening 　ここを参考に自分のブックで動くように改変しました 隠居Zさん ありがとうございます 明日試してみます。 （PHL） 2022/11/23(水) 22:22:25 ---- 日があいてしまいました。 隠居Zさん　???さん　トォーリス・ガリさん　もこな２さん ありがとうございました 隠居Zさんの If Dir(Cur_Path & "\" & New_Name) = "" Then ThisWorkbook.SaveAs Cur_Path & "\" & New_Name Else MsgBox "同じ日付があるので違う日付を入力してください" Exit Sub End If で解決しましたが、Range("V1").Valueの値は無視して、G10Vの値だけで重複の判定をするにはどうしたらよいのでしょうか。 （PHL） 2022/11/26(土) 18:11:58 ---- Dim wbn As String G10V = Sheet3.Range("G10") 'ファイルのパス、ファイル名の読み込み Cur_Path = ThisWorkbook.Path Cur_Name = ThisWorkbook.Name New_Name = "作業日報-" & G10V & "（" & Worksheets("作業").Range("V1").Value & "）" & ".xlsm" wbn = Dir(Cur_Path & "\" & "作業日報-" & G10V & "*.xlsm") If Dir(Cur_Path & "\" & wbn) = "" Then ThisWorkbook.SaveAs Cur_Path & "\" & wbn Else MsgBox "同じ日付があるので違う日付を入力してください" Exit Sub End If これで問題なく動きました。 （PHL） 2022/11/26(土) 18:32:46 ---- （隠居Z） 2022/11/23(水) 16:47:14 は、全く違う名前のマクロブックが一つある、かもしれない。。。かも。。。＾＾； という 前程で、G10Vの値だけ抽出し、条件分岐致しました。←つもり。。。；(￣▽￣) 何をどうしたのか、ほとんど失念致しておりまして。 もし、失敗していましたら、お許しを。m(__)m ＞＞これで問題なく動きました。 ま。。。いろいろ、ケースバイケースで条件が違いますもので 問題が無ければ、何よりでございます。m(__)m でわ （隠居Z） 2022/11/26(土) 18:59:38 ---- 隠居Zさん 返信ありがとうございます。 ちょうど動かなかったと書き込もうとしていたところです。。。 G10の値だけでメッセージボックスを出すにはどうしたらよいのでしょう New_Name = "作業日報-" & G10V & "（" & Worksheets("作業").Range("V1").Value & "）" & ".xlsm" wbn = Dir(Cur_Path & "\" & "作業日報-" & G10V & "*.xlsm")　ここを変えればできそうですか If Dir(Cur_Path & "\" & wbn) = "" Then ThisWorkbook.SaveAs Cur_Path & "\" & wbn Else MsgBox "同じ日付があるので違う日付を入力してください" Exit Sub End If （PHL） 2022/11/26(土) 19:09:18 ---- 拡張子だけでファイル形式が決まると思っていると ファイルがっ壊れるぞ、破壊王になるつもりですか。 （破壊王） 2022/11/26(土) 19:30:43 ---- うへ〜、ははぁ〜m(__)m 王様。。。仰せのままに。Saveasの最後に、,52 を付けるようにいたしましょう。＾＾；すみませ〜ん、有難う御座いました。 PHL　さんへ　（隠居Z） 2022/11/23(水) 16:47:14 の 一度tmp(1)を表示させてみて下さいませ。←動きませんでしたか(#^^#；) m(__)m （隠居Z） 2022/11/26(土) 20:59:57 ---- ちょっと話が進んでいるのようなので前後する部分もありますが何点か。 ■４ ＞ 221123の後に追い番号をつけます 話がよく見えませんが、何かのっぴきならない事情があるのですかね。 無理強いはしませんので好きにしてください。 なお、同名ファイルが既にある場合には枝番を付すという話ならば、↓が参考になるでしょう。 【参考】 [[20220927165342]]　『ファイル保存時に同じ名前のファイルがあったとき番号を付ける』（SPQ） ■５ ＞Dirを使うのですよね ほかにもアドバイスされているのでは？ （ファイルパスが長い場合、Dir関数だと問題が発生すると思います） ■６ ＞ここを参考に自分のブックで動くように改変しました リンク先を見てみましたが、やはり私には理解できません。 別名で保存した段階で前のブックと別物になりますから、保存したブックを開きなおす必要ないと思いますが・・・私の勘違いですかね。 ■７ こちらも興味本位ですが↓はどういう意図があるのでしょうか？ G10V = Sheet3.Range("G10") 意図的であれば別によいかもしれませんが、あんまりシートをオブジェクト名で指定するのはおすすめしません。 ■８ ＞これで問題なく動きました。 ＞ちょうど動かなかったと書き込もうとしていたところです。。。 ＞G10の値だけでメッセージボックスを出すにはどうしたらよいのでしょう どこがどう思うとおりで無かったのかもう少し説明は可能ですか？ （■７と関連しているような気もしますが。。。） （もこな２） 2022/11/26(土) 21:38:58 ---- 隠居Zさん （隠居Z） 2022/11/23(水) 16:47:14 のマクロを実行すると 実行時エラー'70': 書き込みができません。 と表示されます。 Kill Cur_Path & "\" & Cur_Nameの行が黄になります フォルダにはほかにもマクロ付きブックが保存されているからでしょうか （室温10度） 2022/11/27(日) 12:30:40 ---- こんにちわ　＾＾　ｗ そぉなのですね。お試しの際は必ず、バックアップ。。。取っておいてくださいね m(__)m 私も少し勘違いしていたかもしれません。 ちょっと見てみますね。いまからご飯食べますので、暫時御猶予を 忙しい訳でも御座いませんので、すぐまた現れますね。＾＾； でわ m(__)m （隠居Z） 2022/11/27(日) 12:38:55 ---- もこな２さん ■４ 参考URL確認してみます そこまでのっぴきならない事情でもないのですが、上司の方針上変えられないといったところです。。。 ■５ ＞Dirを使うのですよね ほかにもアドバイスされているのでは？ （ファイルパスが長い場合、Dir関数だと問題が発生すると思います） ■６ ＞ここを参考に自分のブックで動くように改変しました リンク先を見てみましたが、やはり私には理解できません。 別名で保存した段階で前のブックと別物になりますから、保存したブックを開きなおす必要ないと思いますが・・・私の勘違いですかね。 私たちの現状を説明しても変なことしているなと思われるような運用だと思います。 私たちは作業日報の下書きを私たちは上司に提出します。 このとき作業日報は「作業日報-nnnn (製品の図番).xlsm」という名前になっています。 上司はこのブックを開き、日報の内容を確認したのちSheet3のG10セルに日付と枝番を入力します。 2022年11月27日の1番目の日報なら221127-1 2022年11月27日の2番目の日報なら221127-2という感じ Sheet3のG10セルの内容は変わりましたが、 作業日報自体は「作業日報-nnnn (製品の図番).xlsm」という名前のままです。 作業日報を閉じて、今閉じたブックの名前を変更をして「作業日報-221127-1（製品の図番）.xlsm」という名前にします。 結構な頻度でG10の日付と作業日報の名前が食い違うのと、ご指摘の通り、製品の図番は膨大にあるので 作業日報-221127-1（製品の図番）.xlsm 作業日報-221127-1（製品の図番）.xlsm という状況が発生し、困っています。これらがどうにかならないかなという次第です。 ■７ こちらも興味本位ですが↓はどういう意図があるのでしょうか？ G10V = Sheet3.Range("G10") 意図的であれば別によいかもしれませんが、あんまりシートをオブジェクト名で指定するのはおすすめしません。 G10Vという変数にSheet3のG10セルの値が入っていると思いますが、ダメですか？ こういう書き方はミスの元ですか？すみません、どうダメか教えてください。 ■８ ＞これで問題なく動きました。 ＞ちょうど動かなかったと書き込もうとしていたところです。。。 ＞G10の値だけでメッセージボックスを出すにはどうしたらよいのでしょう どこがどう思うとおりで無かったのかもう少し説明は可能ですか？ （■７と関連しているような気もしますが。。。） Sheet3のG10セルの値を221130-1　存在しない未来の日付 Sheet3のG10セルの値を221123-100　存在しない枝番 にしてもメッセージボックスが出てしまいます。 製品の図番は違うものを入力してあります。 （PHL） 2022/11/27(日) 13:07:55 ---- こんにちわ　＾＾ え〜と、最初から気になっていたのですが。少し私の頭を整理したいので １．このマクロがあるブックは、使い回されているのでしょうか。 ２．前ブックを削除すれば、数は増える事は無いはずなのですが、複数 　　しかも、枝番付きで、存在するのですね。 3　.操作マクロは、別フォルダ[一層上のとか]で常在させておく。と 　　混乱しなくて良いかもです。 削除する訳とファイルが溜まる理由をを教えて戴けると幸甚です。 （隠居Z） 2022/11/27(日) 14:06:43 ---- ↑ご返信いただければ、別ですが、 私自身、おやりになりたい事が、よく、掌握できていないと思いますので 最初からもう一度、よく読みなおしてみます。←　頭の整理が出来るまで 少し、撤収致します。他の回答者様のアドバイスを、引き続きお待ちくださいませ。 でわ。相済みません。又、閃いたら、現れるかもしれません。m(__)m。 （隠居Z） 2022/11/27(日) 14:42:40 ---- ■９ ＞G10Vという変数にSheet3のG10セルの値が入っていると思いますが、ダメですか？ 繰り返しになりますが、意図的であれば結構かと思います。 ただ、私なら【シート名】で指定しますね。 変数 = Worksheets("Sheet3").Range("G10").Value また、Index番号で指定するのも有効かもしれません。 変数 = Worksheets(3).Range("G10").Value ■10 ＞Sheet3のG10セルの値を221130-1　存在しない未来の日付 ＞Sheet3のG10セルの値を221123-100　存在しない枝番 ＞にしてもメッセージボックスが出てしまいます。 ＞製品の図番は違うものを入力してあります。 まだ理解できません。が、↓からして【製品の図番】は関係ないでしょう If Dir(Cur_Path & "\" & Dir(Cur_Path & "\" & "作業日報-" & G10V & "*.xlsm")) = "" Then フォルダパスは適当で構いませんから、【どういう名前（パス）のファイルがあるとき】に、どういう【ファイル名】に対して、【どのような判定】をしたいのか説明できませんか？ 例１ 【C:\hogehoge\作業日報-221130-1（9999-1）.xlsm】 というファイルが既にある場合 Sheet3のG10セルの値が【221130-1】であったら 別日にするようメッセージを表示したい 例２ 【C:\hogehoge\作業日報-221130-1（9999-1）.xlsm】 というファイルが既にある場合 Sheet3のG10セルの値が【221130】であったら 別日にするようメッセージを表示したい （221130-2 だろうと、221130-3 だろうとチェックの対象にしたい） （もこな２） 2022/11/27(日) 15:44:34 ---- ■９ 達人にならって私も 変数 = Worksheets("Sheet3").Range("G10").Value のように書くようにします ■10 ＞Sheet3のG10セルの値を221130-1　存在しない未来の日付 ＞Sheet3のG10セルの値を221123-100　存在しない枝番 ＞にしてもメッセージボックスが出てしまいます。 ＞製品の図番は違うものを入力してあります。 まだ理解できません。が、↓からして【製品の図番】は関係ないでしょう If Dir(Cur_Path & "\" & Dir(Cur_Path & "\" & "作業日報-" & G10V & "*.xlsm")) = "" Then フォルダパスは適当で構いませんから、【どういう名前（パス）のファイルがあるとき】に、どういう【ファイル名】に対して、【どのような判定】をしたいのか説明できませんか？ 例１ 【C:\hogehoge\作業日報-221130-1（9999-1）.xlsm】 というファイルが既にある場合 Sheet3のG10セルの値が【221130-1】であったら 別日にするようメッセージを表示したい 例２ 【C:\hogehoge\作業日報-221130-1（9999-1）.xlsm】 というファイルが既にある場合 Sheet3のG10セルの値が【221130】であったら 別日にするようメッセージを表示したい （221130-2 だろうと、221130-3 だろうとチェックの対象にしたい） まさに例１がやりたい動作です 【C:\hogehoge\作業日報-221130-1（9999-1）.xlsm】 というファイルが既にある場合 Sheet3のG10セルの値が【221130-1】であったら 別日にするようメッセージを表示したい Sheet3のG10セルの値が【221130-2】であったら メッセージを表示しない （PHL） 2022/11/27(日) 20:26:33 ---- １．このマクロがあるブックは、使い回されているのでしょうか。 使いまわしています。 原紙があって、それをコピーして使っています。 ２．前ブックを削除すれば、数は増える事は無いはずなのですが、複数 　　しかも、枝番付きで、存在するのですね。 C:\User\USER\作業日報置き場\作業日報-221129-1（製品の図番）.xlsm C:\User\USER\作業日報置き場\作業日報-221129-2（製品の図番）.xlsm C:\User\USER\作業日報置き場\作業日報-221129-3（製品の図番）.xlsm C:\User\USER\作業日報置き場\作業日報-221130-1（製品の図番）.xlsm C:\User\USER\作業日報置き場\作業日報-221130-2（製品の図番）.xlsm 200801-1〜現在まで「作業日報置き場」にあります。 3　.操作マクロは、別フォルダ[一層上のとか]で常在させておく。と 　　混乱しなくて良いかもです。 （隠居Z） 2022/11/27(日) 14:06:43 （PHL） 2022/11/27(日) 20:36:54 ---- おはようございます。＾＾ なぁ〜〜〜んとなく、概略が解ってきたような気がいたします。＾＾； 作成はしているのですが、何分、手が遅いため、。。。ｗ 今、日付の索引を勘案中(*'▽')。。。ルン 他の回答者様のアドバイスも合わせてお待ちくださいませ。←言い訳(￣▽￣) でわでわ m(_ _)m （隠居Z） 2022/11/28(月) 11:23:43 ---- マクロブックの正体がつかめないままで、動くだけなるコード。。。＾＾； みたいな感じで、私が実務で使うならマクロブックは固定にしますけど。 よく、わからなかったもので、どれでもマクロブックみたいになってしまいました。処理ファイル数の限界対策、その他諸々のエラー処理は御座いません (◎_◎;) ま、ご環境に合わせて、ご変更戴くとして、使い物にわならないと思いますが。 ご開発の砌、何かの参考にでもなれば、幸甚です。ならなければ、ゴミ箱ポイ(*^^*) お願い致しますです。間違っていないかなぁ。？＾＾；でわでわ m(_ _)m Option Explicit Sub myHozon02() Dim Cur_Path As String 'ファイルのパス Dim Cur_Name As String '元のファイル名 Dim New_Name As String '変更後のファイル名 Dim G10V As String 'G10の値 Dim G10V_2 As String Dim xfn As String Dim Read_F As Variant Dim tmp As Variant Dim tB As Workbook Dim fS As Object Dim eDa As Long Dim invFlg As Boolean Dim fidx() As Variant Dim i As Long Dim x As Variant Dim cnt As Long Set fS = CreateObject("Scripting.FileSystemObject") G10V = Worksheets("Sheet3").Range("G10") Set tB = ThisWorkbook Cur_Path = tB.Path Cur_Name = tB.Name G10V_2 = Split(G10V, "-")(0) xfn = G10V New_Name = "作業日報-" & G10V & "（" & Worksheets("作業").Range("V1").Value & "）" & ".xlsm" MsgBox "New_Name = " & Chr(13) & Chr(13) & New_Name For Each Read_F In fS.getFolder(Cur_Path).Files tmp = Read_F.Name If Read_F.Attributes = 32 And Left(tmp, 5) = "作業日報-" Then ReDim Preserve fidx(i) fidx(i) = Mid(Split(StrConv(Read_F.Name, vbNarrow), "(")(0), 6) i = i + 1 If i Mod 32 = 0 Then DoEvents End If Next For Each Read_F In fS.getFolder(Cur_Path).Files tmp = Read_F.Name If tmp Like "*" & G10V & "*" And _ Read_F.Attributes = 32 And _ Left(tmp, 5) = "作業日報-" And _ fS.GetExtensionName(Cur_Path & "\" & tmp) = "xlsm" Then Do x = Application.Match(xfn, fidx, 0) If IsError(x) Then invFlg = True New_Name = "作業日報-" & xfn & _ "（" & Worksheets("作業").Range("V1").Value & "）" & ".xlsm" Exit Do End If xfn = G10V_2 & "-" & eDa eDa = eDa + 1 If eDa Mod 32 = 0 Then DoEvents Loop If invFlg = False Then Exit For End If cnt = cnt + 1 If cnt Mod 32 = 0 Then DoEvents Next If invFlg Then If MsgBox(New_Name & "が使用可能です", vbOKCancel) <> vbCancel Then ThisWorkbook.SaveAs Cur_Path & "\" & New_Name, 52 End If Else ThisWorkbook.SaveAs Cur_Path & "\" & New_Name, 52 End If Erase fidx Set fS = Nothing End Sub （隠居Z） 2022/11/28(月) 14:41:49 ---- 隠居Zさん ありがとうございます。 動作確認してみます。 ステートメントごと理解をしていきます。 （PHL） 2022/11/29(火) 13:22:22 ---- If invFlg = False Then Exit For を If invFlg = True Then Exit For に ご変更くださいませ。←　済みません、すみません とても、無駄な事をしています。結果は多分変わらないかもしれませんが＾＾； 解りません。(￣▽￣；) 最初、FALSE、にしていて、後でTRUEにしたとき 変更しないといけなかったのを、失念致しております。 m(__)m。 （隠居Z） 2022/11/29(火) 14:38:09 ---- 隠居Zさん （隠居Z） 2022/11/28(月) 14:41:49 （隠居Z） 2022/11/29(火) 14:38:09 マクロありがとうございました 複雑な処理とたくさんの変数で頭が混乱しております。 使用可能な日付を提案してくれていると思いますが、単純に 「この日付はもう使っているので別の名前にしてください」とするにはどうしたらよいのでしょうか。 （PHL） 2022/11/30(水) 16:21:20 ---- 最初の質問に立ち返って単純にこういうことではダメなんですか？ Sub ex() Dim Cur_FullPath As String Dim New_FullPath As String Cur_FullPath = ThisWorkbook.FullName New_FullPath = ThisWorkbook.Path & "\作業日報-" & Sheet3.Range("G10") & "（" & Worksheets("作業").Range("V1").Value & "）" & ".xlsm" On Error Resume Next ThisWorkbook.SaveAs New_FullPath If Err Then MsgBox "保存できませんでした。日付または、？？？を変更してください。", vbCritical Exit Sub End If On Error GoTo 0 If Cur_FullPath <> New_FullPath Then Kill Cur_FullPath End If End Sub （´・ω・`） 2022/11/30(水) 16:44:24 ---- こんばんわ。。。＾＾ （´・ω・`） さんから、既にご案内ですが。。。＾＾ ほとんど、何を書いたのか忘却致しておりまして、影響なしでの簡略化には私のスキル では再構築するくらいお時間がかかりますもので、間に合わせ修正です、また複雑だと のご指摘が。。。←私もそう思います。＾＾；ので簡略ながらコメントを書込みました。 これにてお許しを。。。m(_ _)m Option Explicit Sub myHozon03() Dim Cur_Path As String 'ファイルのパス Dim Cur_Name As String '元のファイル名 Dim New_Name As String '変更後のファイル名 Dim G10V As String 'G10の値 Dim G10V_2 As String '枝番なしの日付 Dim xfn As String '更新ファイルの日+枝番 Dim Read_F As Variant '読込ファイル Dim tmp As Variant '作業用 Dim tB As Workbook 'マクロブック Dim fS As Object 'ファイルシステムオブジェクト Dim eDa As Long '枝番号 Dim invFlg As Boolean '同名ファイル存在標識[変数名が変かも＾＾；] Dim fidx() As Variant '実在作業日報の、日+枝番一覧表 Dim i As Long 'ループカウンタ Dim x As Variant '存在確認の戻り値[数式Match] Dim cnt As Long '一番外のループカウンタ、フリーズ対策用 'ファイルシステムオブジェクト使用 Set fS = CreateObject("Scripting.FileSystemObject") G10V = Worksheets("Sheet3").Range("G10") 'このマクロブックを格納 Set tB = ThisWorkbook 'このマクロブックのパス Cur_Path = tB.Path 'このマクロブックの名前 Cur_Name = tB.Name '年月日抽出 G10V_2 = Split(G10V, "-")(0) 'G10Vは変えたくないので初期値に設定 xfn = G10V '同､日付 枝番のブックが無い場合の保存ブック名 New_Name = "作業日報-" & G10V & "（" & Worksheets("作業").Range("V1").Value & "）" & ".xlsm" 'MsgBox "New_Name = " & Chr(13) & Chr(13) & New_Name '先に、作業日報の年月日+枝番のみを配列、fidx　に取込 For Each Read_F In fS.getFolder(Cur_Path).Files tmp = Read_F.Name If Read_F.Attributes = 32 And Left(tmp, 5) = "作業日報-" Then ReDim Preserve fidx(i) fidx(i) = Mid(Split(StrConv(Read_F.Name, vbNarrow), "(")(0), 6) i = i + 1 If i Mod 32 = 0 Then DoEvents End If Next 'Worksheets("Sheet3").Range("G10")の値が含まれている、且つ '実存ファイル[隠し、システムファイル等々省く]、且つ '先頭から5文字目が作業日報- '拡張子がxlms 'を条件に処理を分岐 For Each Read_F In fS.getFolder(Cur_Path).Files tmp = Read_F.Name If tmp Like "*" & G10V & "*" And _ Read_F.Attributes = 32 And _ Left(tmp, 5) = "作業日報-" And _ fS.GetExtensionName(Cur_Path & "\" & tmp) = "xlsm" Then '重複しない年月日+枝番が見つかるまで作成した一覧表から検索 Do '一回目はWorksheets("Sheet3").Range("G10")で有無を調べる '二回目以降は枝番を付けて調べる 'xがエラーなら[見つからなかった＝年月日[+枝番含む]の重複無し] 'と判断して、標識を立て[TRUEにするだけ]、ループを抜ける x = Application.Match(xfn, fidx, 0) If IsError(x) Then invFlg = True New_Name = "作業日報-" & xfn & _ "（" & Worksheets("作業").Range("V1").Value & "）" & ".xlsm" Exit Do End If 'ここからは二回目以降になるので枝番号付きに置き換え xfn = G10V_2 & "-" & eDa '枝番を1増やす eDa = eDa + 1 '一時制御をシステムに返す[フリーズ防止対策] If eDa Mod 32 = 0 Then DoEvents Loop '標識が立っていたら[TRUEなら]同じ処理を繰り返さない為早々にループから脱出 If invFlg = True Then Exit For End If 'フリーズ防止用の単なるカウンタを1加算 cnt = cnt + 1 If cnt Mod 32 = 0 Then DoEvents Next '標識が立っていたら[TRUEなら]メッセージを表示して終了。 If invFlg Then MsgBox "保存できませんでした。日付または、？？？を変更してください。", vbCritical ' If MsgBox(New_Name & "が使用可能です", vbOKCancel) <> vbCancel Then ' ThisWorkbook.SaveAs Cur_Path & "\" & New_Name, 52 ' End If '標識が立っていなければ[FALSEなら]名前を付けて保存して、終了 Else ThisWorkbook.SaveAs Cur_Path & "\" & New_Name, 52 End If '後処理、配列とファイルシステムオブジェクトの破棄 Erase fidx Set fS = Nothing End Sub （隠居Z） 2022/11/30(水) 20:10:35 ---- 追伸 プロシジャーをコピペで別名にでもして 関係の無い箇所は全てコメントアウトし、 ↑　そこまでしなくとも、何らかのかたちで、作業用シートにでも fidx とか、他の変数 の中身を書き出して見ると、一段と解りやすいですよ。 デバッグ時、私はよくやります。 ローカル、イミディエイトとかより、時によっては、私は解りやすいです。 何でも中身確認→これ、私の昔からの癖かも。。。＾＾； でわでわ。m(__)m （隠居Z） 2022/11/30(水) 20:48:10 ---- 解決したのかしてないのかよくわかりませんが、こういうことだったのかも・・・ ★１<<作業員の場合>> 該当日が【上司が確認したファイル】（枝番号がついているもの）であれば日付を変えるように警告する ★２<<上司の場合>> 保存時に【日付を表す文字列に枝番号を付与して】保存する (もしも、既に枝番号がついていれば、枝番号+1する） 前提１：「Sheet3」のG3セルには【日付型】の値を入力する 前提２：削除すると怖いので、【直下の"過去ファイル"というフォルダに移動させる】 Sub 作業員用() Dim 日付 As String, 図番 As String Dim 元ファイル名 As String 日付 = Format(ThisWorkbook.Worksheets("Sheet3").Range("G10").Value, "yymmdd") 図番 = "（" & ThisWorkbook.Worksheets("作業").Range("V1").Value & "）" If Dir(ThisWorkbook.Path & "\作業日報-" & 日付 & "-??" & 図番 & ".xlsm") <> "" Then MsgBox 日付 & "は、既に上司確認済です" & vbLf & "別日を設定してください" Exit Sub Else 元ファイル名 = ThisWorkbook.Name ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\作業日報-" & 日付 & 図番 If ThisWorkbook.Name <> 元ファイル名 Then Name ThisWorkbook.Path & "\" & 元ファイル名 As ThisWorkbook.Path & "\過去ファイル\" & 元ファイル名 End If End If End Sub '------------------------------------------------------------------------------------------------------- Sub 上司用() Dim 日付 As String, 図番 As String Dim 元ファイル名 As String Dim tmp As String Dim 枝番 As Long 日付 = Format(ThisWorkbook.Worksheets("Sheet3").Range("G10").Value, "yymmdd") 図番 = "（" & ThisWorkbook.Worksheets("作業").Range("V1").Value & "）" 元ファイル名 = ThisWorkbook.Name tmp = Replace(CreateObject("Scripting.FileSystemObject").GetBaseName(ThisWorkbook.FullName), "作業日報-", "") tmp = Replace(tmp, 図番 & "", "") If Len(tmp) = 6 Then 枝番 = 1 Else 枝番 = Right(tmp, 2) * 1 + 1 End If ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\作業日報-" & 日付 & "-" & Format(枝番, "00") & 図番 Name ThisWorkbook.Path & "\" & 元ファイル名 As ThisWorkbook.Path & "\過去ファイル\" & 元ファイル名 End Sub このようにすれば、フォルダ内には図番ごとに常に最新のファイルのみ存在する状況になるとおもいます。 （もこな２） 2022/12/01(木) 18:33:30 ---- 返信が遅くなってすみません 隠居Zさん、（´・ω・`）さん、もこな2さん ありがとうございます 隠居Zさん、説明をつけていただきありがとうございます ステップ実行で学習をしたいと思います （´・ω・`）さん エラー処理の勉強になります ありがとうございます もこな2さん ありがとうございます やはり削除する私たちの運用は見直した方が良さそうですね 相談してみます ステップ実行で学習してみます 達人の皆さんありがとうございました （´・ω・`）さんのマクロを使って問題は解決しましたが 次は自分で作れるように学習します ありがとうございました （PHL） 2022/12/02(金) 20:20:56