[[20221123103736]]　『エラー1004の回避』（PHL）　ページの最後に飛ぶ

『エラー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セルの値が入っていると思いますが、ダメですか？
こういう書き方はミスの元ですか？すみません、どうダメか教えてください。

どこがどう思うとおりで無かったのかもう少し説明は可能ですか？
（■７と関連しているような気もしますが。。。）

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
のように書くようにします

まだ理解できません。が、↓からして【製品の図番】は関係ないでしょう

 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

コメント返信：

[ 一覧(最新更新順) ]

[[20221123103736]] 『エラー1004の回避』（PHL） ページの最後に飛ぶ

[[20221123103736]]　『エラー1004の回避』（PHL）　ページの最後に飛ぶ