スキルアップ・問題解決なら、モーグにおまかせ！

お世話になります。
 
テスト.xlsmという元ファイルがあり、毎日23時59分40秒に元ファイルは開いたままで
ファイル名がテスト_当日の日付.xlsmになるようにコピー保存を出来るようにしたいのですが
下記のコードからすると元ファイルと同じフォルダに保存されると思ったのですが同フォルダに該当のファイルが存在していなかったです。
(保存場所は元ファイルと同じフォルダC:\Users\ユーザー名\Desktop\テストになります。)
 
なぜ上記のような現象になっているのか分からない状況です。
 
説明が分かり辛く申し訳ないのですがアドバイス又はヒントを頂ければ幸いです。
 
宜しくお願い致します。
 
Microsoft Excel Objects内のワークシートコード
 
Option Explicit
'入力設定
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
 
    If Not Intersect(Target, Me.Range("B4")) Is Nothing Then'(B列は氏名を入力)
        Application.OnTime earliesttime:=TimeValue("23:59:40"), procedure:="当日のファイルを保存して翌日のファイルを開く"
    End If
 
End Sub
 
 
標準モジュールコード
Option Explicit
 
Public Sub 当日のファイルを保存して翌日のファイルを開く()
 
ThisWorkbook.Save
 
Application.DisplayAlerts = False
 
Dim A, B, C, D '変数A B C D設定
 
    A = "テスト" 'ファイル名
    B = Format(Now(), "yyyy年mm月dd日") '日付
    C = A & "_" & B & ".xlsm" 'ファイル名（拡張子付き）
    D = ThisWorkbook.Path & "\" & C 'ファイルパス
     
    'ブックをコピーして保存
    ThisWorkbook.SaveCopyAs FileName:=D
 
    Application.DisplayAlerts = True
 
    Range("B4:G5003").ClearContents '氏名列一括削除
    Range("C4:G5003").ClearContents '入構時刻〜検印列削除
 
    Range("B4").Select '新規ファイル作成し開いた時にB4セルを選択するようにする
    Range("B4").Activate '新規ファイル作成し開いたときにB4セルから入力できるようにする
     
    ThisWorkbook.Save '上書き保存
 
End Sub

引用:
テスト.xlsmという元ファイルがあり、毎日23時59分40秒に元ファイルは開いたままで
ファイル名がテスト_当日の日付.xlsmになるようにコピー保存を出来るようにしたい

引用:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  
    If Not Intersect(Target, Me.Range("B4")) Is Nothing Then'(B列は氏名を入力)
        Application.OnTime earliesttime:=TimeValue("23:59:40"), procedure:="当日のファイルを保存して翌日のファイルを開く"
    End If
  
End Sub

sk様
 
ご回答ありがとうございます。
 
本件の場合、日付が変わった際のファイルでB4セル入力は必ず行われる前提で
条件を明記してあります。
 
ただ、実際に操作する際に何か手違いがあってB4セルの入力が行われない可能性があるので
対策を立てられるか再度調査してみます。

引用:
実際に操作する際に何か手違いがあってB4セルの入力が行われない可能性があるので
対策を立てられるか再度調査してみます。

引用:
Range("B4:G5003").ClearContents '氏名列一括削除
    Range("C4:G5003").ClearContents '入構時刻〜検印列削除

Suzu様
 
返答が遅くなってしまい、申し訳ございません。
ご回答ありがとうございます。
 
ご質問に対してです。
 
Q1. B4 の Changeイベントでないとダメな理由は何ですか？
WorkBookのOpenイベントではダメなの？
 
A.理由としましてはもし入力がなかった場合には保存のしなくても良いのではというアドバイスを頂いていたのでこのようなコードを組んでいました。
今回のような不具合が起こったのであればWorkBookのOpenイベントでも良いという結論になりました。
 
Q2. ClearContents をどのファイルに実行しようとされていますか？
当日 日名 でSaveCopyAs にて保存したファイルではなく、
現在開いているファイル になりますがよいでしょうか？
  
お好みの動作が実現されたとして、
ユーザーの入力操作中 に、当該時刻になった場合 実行されない可能性があります。
　(編集モードになっている等)
　（実行タイミングが 20秒ずれると、ファイル名 次の日の分になります。）
  
消さないとダメな理由は？
ひな形ファイルを用意して、そのファイルをコピーするではダメ？
 
A.ひな形ファイルを用意して、そのファイルをコピーするやり方までは思いついてなかったです。
調査して試してみます。
 
以上になります。

ひな形を用意し、定時に コピーする事で済むのであれば
 
Windows の タスクスケジュラーにて、コピーさせた方が良いと思います。
Excel の起動の必要もないですから、Excel の 入力状態等に影響を受けませんから。
 
以下コードは、
ファイル C:\DATA\TEST\Source.txt を
ファイル C:\DATA\TEST\Target20240515.txt としてコピーします。
 
コード中のパスは環境に合わせて修正ください。
 

Dim FS 'As Scripting.FileSystemObject

Dim yyyymmdd 'As String
Dim strSource 'As String
Dim strDestination 'As String

yyyymmdd = Date
yyyymmdd = Replace(yyyymmdd, "/", "")

strSource = "C:\DATA\TEST\Source.txt"
strDestination = "C:\DATA\TEST\Target" & yyyymmdd & ".txt"

Set FS = CreateObject("Scripting.FileSystemObject")
 'コピー元のファイル存在確認
 If FS.FileExists(strSource) = True Then
  'コピー元ファイルが存在する場合
  'コピー先ファイル存在確認
  If FS.FileExists(strDestination) = False Then
   'コピー先ファイルが存在しない場合
   FS.CopyFile strSource, strDestination
  End If
 End If
Set FS = Nothing

つかぬことを伺います。
予約した処理が実行されない、というのが課題と受け止めました。
コードを見る限り、何か致命的な間違いは無いように思います。
通常であれば実行されるように思いました。
皆さんご指摘のとおりです。
 
ただし、予約した処理のあとで、Excelアプリケーションをいったん閉じて、再度開きました、
といったことは無いですね。念のため。
 
入構時刻などという言葉からすると、入退出の管理業務なんでしょうか？単なる例ですか？
 
私なら、OnTimeなどというのは余り使う気にはなれません。
予約を継続するためにずっとExcelを立ち上げたままにするようなことは却って無駄な気がします。
うっかり二日分記入してしまったなどということは無いのでは？
テンプレートを使って、日付別のブックを予めまとめて一週間なり一か月なり
作成しておけば良いと思います。（この部分はマクロを利用できます）

Suzu様
 
重ね重ねアドバイスありがとうございます。
 
タスクスケジューラーに関しましては私自身では操作出来ないルールになっているため(今回の使用しているPCが会社PCです)
万が一どうしようもなければ情報責任者に相談してみます。
 
simple様
 
仰る通り入退出の管理業務でマクロを組んでおります。
 
テンプレートを使って、日付別のブックを予めまとめて一週間なり一か月なり
作成しておけば良いと思います。（この部分はマクロを利用できます）
↑
その方法が確実ですね。恥ずかしながら今まで思いつかなかったです。
是非参考にさせて頂きます。
 
 
Suzu様 simple様
おかげさまで無事にマクロが作動することが出来ました。    
様々なアドバイスを頂き本当にありがとうございました。