Microsoft Access 掲示板

ありがとうございます！
コードは書かれていたのですが、まさに
＞レポートヘッダーを使っていない、または、レポートヘッダーのフォーマット時に[イベント プロシージャ]が設定されていないとか？
これでした！
コードに書いたらそこに記載されると思い込んでいました。失礼しました…

これで無事表示できるようになりました。

しかし、やっぱり元々希望している
【行の高さに係わらず、上下中央にテキストを配置】
ができません…（画像参照）

なお、hirotonさまの仰る
＞ちょっと試してみましたがReDim h(1 To Me.件数)はレポートの読み込み時（Report_Load）にやるのがオススメですかね
も、hatenaさまの仰るレポートヘッダーのフォーマット時もどちらも試しましたが結果は同じでした。

レポートヘッダーを使っていない、または、レポートヘッダーのフォーマット時に[イベント プロシージャ]が設定されていないとか？

ちょっと試してみましたがReDim h(1 To Me.件数)はレポートの読み込み時（Report_Load）にやるのがオススメですかね

今は「一切気にしない」ですね

（プロシージャの）順番に意味を持たせることがナンセンスだと思っています

ACCESSオブジェクト上からなら[イベント プロシージャ]なら「...」で、ユーザー定義関数なら関数名で検索。VBE上なら右クリックのポップアップメニュー内「定義」「元の位置へ移動」コマンド
ソートした順番で探したいのであれば上部のコンボボックスから
「記述」時点で後々それが重要になるということはまずありません

実際の処理に従って、ということであれば、プロシージャを小分けにした親子関係にしかないモノから、モジュール内で共有の関数、標準モジュールに記述する共通関数等、テキストの記述順で収まるような関係にはならないので、やはりそれを念頭にというのは余計な負荷になります

必要なモノを適切な名前で、適切なモジュール内に記述しておけば、ジャンプ機能でしか参照しないので順番を気にすることはないということですね

やはり同じところで同じエラーが出ます。

何か提示し足りない情報があるということですよね…
コードはこれが全部なので足りないとなると、元になるクエリとかレポートの設定なのでしょうか…

それとももう諦めたほうが良いのでしょうか…

Report_Open時では件数は取得できませんでした。

Report_Open内の下記のコードを削除して、

    ReDim h(1 To Me.件数) '配列のサイズをレコード数分に設定

レポートヘッダーのフォーマット時のイベントプロシージャを下記のように記述してください。

Private Sub レポートヘッダー_Format(Cancel As Integer, FormatCount As Integer)
    If Me.Pages = 0 Then
        ReDim h(1 To Me.件数) '配列のサイズをレコード数分に設定
    End If
End Sub

＞あと、下記の部分はそちらのレポートの設定にあわせて、ご希望のレイアウトになるようにコードを記述してください。こちらではそちらのレポートの設定は分かりませんので。
の部分なのですが、すみません。意味がよくわからなかったので一旦そのままにしてあります。

印刷時拡張後のセクションを高さを取得する方法を回答してます。
取得した高さを利用して、ご希望のレイアウトに設定するコードは亞紀姐さんが自分で考えて書いてくださいということです。

ありがとうございます。
返答が遅くなりすみません。

上記のように変更し、以下のコード（全部コピーしました）にしましたが、やはり同じところで止まってしまいます。
（＞しかし、「h(Me.CurrentRecord) = Me.詳細.Height」のところで「インデックスが有効範囲にない」と言われて見ることが出来ませんでした。）
Me.CurrentRecord　にマウスオーバーすると「1」と表示され
Me.詳細.Height　にマウスオーバーすると「798」と表示され
h　にマウスオーバーすると「h(Me.CurrentRecord) = ＜インデックスが有効範囲にありません＞」と表示されます。

Option Compare Database
Option Explicit

Const A4Height As Long = 21 * 567   'A4用紙の高さ=29.7cm、横の場合=21.0cm、1cm=567twips
Dim PageHeight As Long
Dim h() As Long '印刷時拡張後の高さを格納する配列

'開くとき
Private Sub Report_Open(Cancel As Integer)
'    Set d = CreateObject("Scripting.Dictionary")
'印刷可能領域下辺のページ上端からの高さを取得
    On Error Resume Next
    PageHeight = A4Height - Me.Printer.BottomMargin
    PageHeight = PageHeight - Me.Section(acPageFooter).Height

    ReDim h(1 To Me.件数) '配列のサイズをレコード数分に設定

End Sub

Private Sub Report_Page()
On Error GoTo Err_Report_Page

Dim LineTop As Long, LineLeft As Long, LineWidth As Long, LineBottom As Long, SecHight As Long
Dim i As Integer

    With Me
        LineTop = .ページヘッダーセクション.Height + .グループヘッダー0.Height
        LineLeft = .直線355.Left
        LineWidth = .直線372.Width
        LineBottom = 21 * 567 - Me.Printer.BottomMargin - Me.Section(acPageFooter).Height
        SecHight = Me.詳細.Height
        '太線 の太さをここで指定
        .DrawWidth = 12
        
        '外枠
         Me.Line (LineLeft, LineTop - .直線355.Height)-(LineLeft + LineWidth - 10, ((21 - 0.5 - 3.998) * 567) - 90), , B
         Me.Line (LineLeft, ((21 - 0.5 - 3.998) * 567) - 95)-(LineLeft + LineWidth - 10, ((21 - 0.5 - 0.5) * 567) - 300 - .直線385.Height), , B

    End With

Exit Sub
Exit_Report_Page:

    Exit Sub

Err_Report_Page:

Select Case Err.Number
Case 2501
MsgBox "印刷するデータは有りません。", vbOKOnly
Resume Exit_Report_Page

Case Else
MsgBox Err.Number & " : " & Err.Discription
Resume Exit_Report_Page

End Select

End Sub
Private Sub グループフッター2_Format(Cancel As Integer, FormatCount As Integer)
On Error GoTo Err_Report_Page
    
    If Me.Top + Me.グループフッター2.Height <= PageHeight Then
        Me.NextRecord = False
        If FormatCount > 10 Then Me.NextRecord = True
        '↑想定外の動作で無限ループになった場合でも、10回で止まる
    Else
        Cancel = True
    End If
    
Exit Sub
Exit_Report_Page:

    Exit Sub

Err_Report_Page:

Select Case Err.Number
Case 2501
MsgBox "印刷するデータは有りません。", vbOKOnly
Resume Exit_Report_Page

Case Else
MsgBox Err.Number & " : " & Err.Discription
Resume Exit_Report_Page

End Select

End Sub
Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
    Dim j As Integer
    Dim i As Integer

    For j = 51 To 57
        Me.DrawStyle = 0
        Me.Line (Me("L" & j).Left, 0)-(Me("L" & j).Left, 144000)
    Next
        
     For i = 2 To 12
        Me.DrawStyle = 2
        Me.Line (Me("L" & i).Left, 0)-(Me("L" & i).Left, 144000)
     Next

    WordWrapOff Me.NAS用, Me.txtFld1
    
Me.NAS用.FELineBreak = False
Me.txtFld1.FELineBreak = False
    
    If Me.Pages = 0 Then 'ダミーのフォーマット時はPages=0
        h(Me.CurrentRecord) = Me.詳細.Height
    Else
        Dim exHeight As Long
        exHeight = h(Me.CurrentRecord)
        'exHeightに拡張後の高さが格納されているのでそれを利用してレイアウトを設定

    End If

End Sub
Private Sub ビル名ヘッダーセクション_Format(Cancel As Integer, FormatCount As Integer)
    If Me.Pages > 0 Then
        Me.txtTo = d(Me.Page) & "番"
    End If
End Sub
Private Sub ビル名フッターセクション_Format(Cancel As Integer, FormatCount As Integer)
    If Me.Pages = 0 Then
        d(Me.Page) = Me.番号
    End If
End Sub
Private Sub Report_NoData(Cancel As Integer)

  MsgBox "対象物件がないか、住所が入力されていません"
  Cancel = True
  MsgBox "NAS用メンテナンス計画表を閉じます。"

End Sub

あと、
＞あと、下記の部分はそちらのレポートの設定にあわせて、ご希望のレイアウトになるようにコードを記述してください。こちらではそちらのレポートの設定は分かりませんので。
の部分なのですが、すみません。意味がよくわからなかったので一旦そのままにしてあります。

まずは表示ができるようにと思い、エラーを消したいのですが
まだ誤っている部分があるかを教えていただけると助かります。
尋ねてばかりですみません。

よろしくお願いいたします。

有難うございます。
 Me.subForm1.Filter = strFilter
のところでエラーが出たので
Me.subForm1.Form.Filter = strFilter
のように以降4行を変更したら正常に動作することが出来ました。

この度は有難うございました。

それぞれのサブフォームのレコードソースのクエリに抽出条件を設定する方法と、
VBAで抽出条件を生成してサブフォームのFilterプロパティに設定する方法が考えられます。

VBAタグが設定してあるのである程度VBAのスキルをお持ちだと思いますので、VBA利用の方法を提案しておきます。

各コントロールの名前は適当にこちらで決めてますので、実際のものに変更してご利用ください。

Private Sub cmdFilter_Click()
    Dim strFilter As String
    
    If Me.txtFromDate.Value <> "" Then
        strFilter = " And 日付>=#" & Me.txtFromDate.Value & "#"
    End If
    If Me.txtToDate.Value <> "" Then
        strFilter = strFilter & " And 日付<=#" & Me.txtToDate.Value & "#"
    End If
    If Me.txtPartsNim.Value <> "" Then
        strFilter = strFilter & " And 部品番号='" & Me.txtToDate.Value & "'"
    End If

    strFilter = Mid(strFilter, 6) '先頭の不要な" And "を削除
    
    Me.subForm1.Filter = strFilter
    Me.subForm1.FilterOn = strFilter <> ""
    Me.subForm2.Filter = strFilter
    Me.subForm2.FilterOn = strFilter <> ""
End Sub

CONCAT関数と、TEXTJOIN関数という新参者が現れたのですね。
確かに便利です。
数百程度のセルの処理だったら、いけそうな感じですね。
ありがとうございました。

にしてもです、社保のフォーマットが、所属部分を左端に持ってきていれば、
誰でも簡単素早く電子申請できるのですよ。

ご参考に。

Sub kansei2(fn As String)
    Dim txt As String
    Dim strName(1) As String
    With Sheets("sheet1")
        strName(0) = WorksheetFunction.TextJoin(",", True, .Cells(1, 1).Resize(, 6))
        strName(1) = WorksheetFunction.TextJoin(",", True, .Cells(4, 1).Resize(, 11))
    End With

    With CreateObject("Scripting.FileSystemObject").OpenTextFile(fn, 1)
        txt = .ReadAll
        .Close
    End With
    
    'Debug.Print strName(0) & vbCrLf & "[kanri]" & vbCrLf & ",001" & vbCrLf & strName(1)
    txt = strName(0) & vbCrLf & "[kanri]" & vbCrLf & ",001" & vbCrLf & strName(1) & vbCrLf & txt
    
    With CreateObject("Scripting.FileSystemObject").OpenTextFile(fn, 2)
        .Write txt
        .Close
    End With

End Sub

Sub Test()
    Call kansei2("C:\Users\tasuk\Desktop\A社保申告\SHFD0006temp - コピー.CSV")
End Sub

社保のCSVファイルは、列数の異なるデータをひとつのファイルにまとめてあるため、
列数が少ない行には、不要なカンマが入ってしまう事が原因でした。
すべて、配列で読み込むとEXCELは止まってしまうため、
大物の個人データの範囲だけCSVで出力した後に、
データ量が少ない所属データを、先頭に書き込んで上書きすればエラーの出ないファイルができます。
電子申請したい方がいたら、ファイル名だけ変更すればそのまま使えるはずなので、コードをアップしておきます。

 Sub kansei()
 Dim fn As String, txt As String
 Dim strName() As String
 ReDim strName(1)

  '配列に値を入れる
  dat = ""
  With Sheets("sheet1")
   For i = 1 To 6
    dat = dat & .Cells(1, i) & ","
   Next
   dat = Left(dat, Len(dat) - 1) '最後のカンマを取り除く
   strName(0) = dat
   dat = ""
   For i = 1 To 11
    dat = dat & .Cells(4, i) & ","
   Next
   dat = Left(dat, Len(dat) - 1) '最終のカンマを取り除く
   strName(1) = dat
  End With

 fn = "C:\Users\tasuk\Desktop\A社保申告\SHFD0006temp - コピー.CSV"
 txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
  'Debug.Print strName(0) & vbCrLf & "[kanri]" & vbCrLf & ",001" & vbCrLf & strName(1)
  txt = strName(0) & vbCrLf & "[kanri]" & vbCrLf & ",001" & vbCrLf & strName(1) & vbCrLf & txt
  Open fn For Output As #1
     Print #1, txt
 Close #1

 End Sub

あっ、間違えてますね。
hirotonさん、ご指摘ありがとうござます。

>> 1

    End If
End If '//←End Subの間違い

じゃないっすかね？

（最後のEnd Ifは対応するIfがない、としてエラーになったため削りました）

削らないでください。必要です。
それでエラーになるなら、提示のコードが実際のものとは異なっていると思います。
実際のコードをコピーして貼り付けてください。

コードはマークダウンのコードブロックにいれてください。
詳細は下記を参照ください。

Microsoft Access 掲示板 の使い方 Microsoft Access 掲示板 - zawazawa

Me.Recordset.RecordCountはレポートでは使えないようですので、下記に修正してください。
まずレポートヘッダーかレポートフッターにテキストボックスを配置して下記のように設定してください。

名前 件数
コントロールソース　=Count(*)
可視 いいえ

   'ReDim h(1 To Me.Recordset.RecordCount) '配列のサイズをレコード数分に設定
   '上記を下記に修正
   ReDim h(1 To Me.件数) '配列のサイズをレコード数分に設定

あと、下記の部分はそちらのレポートの設定にあわせて、ご希望のレイアウトになるようにコードを記述してください。こちらではそちらのレポートの設定は分かりませんので。

  'exHeightに拡張後の高さが格納されているのでそれを利用してレイアウトを設定

ありがとうございます。
レポート上には
「=Int(([番号]/6)+0.9) & "頁／" & Int((Count([ビル名])/6)+0.9) & "頁中"」
というテキストボックスがあるのですが、多分それだとうまく作動しないのでは、と思い
「=[Pages]」
という非可視のテキストボックスを作りました。

コードに関しては、現状のコードに追加する形で

Option Compare Database
Option Explicit
'Dim d As Object    ' Dictionary オブジェクト用変数

Const A4Height As Long = 21 * 567   'A4用紙の高さ=29.7cm、横の場合=21.0cm、1cm=567twips
Dim PageHeight As Long
Dim h() As Long '印刷時拡張後の高さを格納する配列

'開くとき
Private Sub Report_Open(Cancel As Integer)
'    Set d = CreateObject("Scripting.Dictionary")
'印刷可能領域下辺のページ上端からの高さを取得
    On Error Resume Next
    PageHeight = A4Height - Me.Printer.BottomMargin
    PageHeight = PageHeight - Me.Section(acPageFooter).Height

    ReDim h(1 To Me.Recordset.RecordCount) '配列のサイズをレコード数分に設定
End Sub

Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
    Dim j As Integer
    Dim i As Integer

    For j = 51 To 57
        Me.DrawStyle = 0
        Me.Line (Me("L" & j).Left, 0)-(Me("L" & j).Left, 144000)
    Next

     For i = 2 To 12
        Me.DrawStyle = 2
        Me.Line (Me("L" & i).Left, 0)-(Me("L" & i).Left, 144000)
     Next

    WordWrapOff Me.NAS用, Me.txtFld1

Me.NAS用.FELineBreak = False
Me.txtFld1.FELineBreak = False

    If Me.Pages = 0 Then 'ダミーのフォーマット時はPages=0
        h(Me.CurrentRecord) = Me.詳細.Height
    Else
        Dim exHeight As Long
        exHeight = h(Me.CurrentRecord)
        'exHeightに拡張後の高さが格納されているのでそれを利用してレイアウトを設定

    End If
End Sub

としました。（最後のEnd Ifは対応するIfがない、としてエラーになったため削りました）

しかし、「h(Me.CurrentRecord) = Me.詳細.Height」のところで「インデックスが有効範囲にない」と言われて見ることが出来ませんでした。

何か他に直さなくてはいけないところがあるのでしょうか？
よろしくお願いします。

フォーマット時イベントで関係する設定を計算してレイアウトを決定します。印刷時イベントでは、それを出力するだけですので、印刷時ではレイアウトは変更できません。

印刷時拡張後の高さは印刷時にしか取得できない、しかし、レイアウト変更は印刷時ではできない、レイアウトの設定には印刷時拡張後の高さが必要である、
ということで普通の方法では不可能な状態です。

そこで利用するのが、下記で紹介している総ページを取得するときのダミーのフォーマット時イベントです。

レポートのイベントの発生メカニズムの研究 その２ - hatena chips

総ページを取得するために最終レコードまでダミーのフォーマット時イベントを発生させる。
その後、先頭に戻って、本番のフォーマット時、印刷時イベントを発生させて実際に出力する。
という動作になってます。

これを利用して、下記のような処理にします。
ダミーのフォーマット時に配列に各行毎の印刷時拡張後の高さを格納しておく。
本番のフォーマット時に配列から印刷時拡張後の高さを取得してそれをもとにレイアウトを設定する。

レポート上のどこでもいいので、総ページ数を取得するためにコントロールソースが=[Pages]のテキストボックスを配置しておく。(すでに総ページ数を表示するためのテキストボックスがあるなら不要)

下記のような感じでレイアウトを設定できます。

Option Compare Database
Option Explicit
Dim h() As Long '印刷時拡張後の高さを格納する配列
'開くとき
Private Sub Report_Open(Cancel As Integer)
    Redim h(1 to Me.Recordset.RecordCount) '配列のサイズをレコード数分に設定
End Sub
 
Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
    If Me.Pages = 0 Then 'ダミーのフォーマット時はPages=0
        h(Me.CurrentRecord) = Me.詳細.Height 
    Else
        Dim exHeight As Long
        exHeight = h(Me.CurrentRecord)
        'exHeightに拡張後の高さが格納されているのでそれを利用してレイアウトを設定

    End If
End If

とても遅くなったのですが、ようやく方向性が決まり、以下のコードになりました。
検索してくださる方のためにもコードを残します。

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

Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
    Dim j As Integer
    Dim i As Integer

    For j = 51 To 57
        Me.DrawStyle = 0
        Me.Line (Me("L" & j).Left, 0)-(Me("L" & j).Left, 144000)
    Next

     For i = 2 To 12
        Me.DrawStyle = 2
        Me.Line (Me("L" & i).Left, 0)-(Me("L" & i).Left, 144000)
     Next

    WordWrapOff Me.自社用, Me.txtFld1

Me.自社用.FELineBreak = False
Me.txtFld1.FELineBreak = False

End Sub

上手い事できました！ありがとうございました

https://www.google.com/search?q=16進数の数字をCSV形式で保存してある物をエクセルで読み込もうとする

テキスト (.txt または .csv) ファイルのインポートまたはエクスポート

注: Excel で .csv ファイルを開くと、Excel は現在の既定のデータの書式設定を使用して、データの各列をインポートする方法を解釈します。 列を別のデータ形式により柔軟に変換する場合は、テキスト インポート ウィザードを使用することができます。 たとえば、.csv ファイルのデータ列の書式が MDY で、Excel の既定のデータ形式が YMD の場合、または先頭のゼロを含む数値の列をテキストに変換して先頭のゼロを維持できるようにする場合などがあります。 Excel でテキスト インポート ウィザードを強制的に実行するには、ファイル名の拡張子を .csv から .txt に変更してから開くか、テキスト ファイルに接続してインポートします (詳細については、次のセクションを参照してください)。

16進コードとは「16進ダンプ」のことです。

16進数の数字をCSV形式で保存してある物をエクセルで読み込もうとすると
"Ｅ"が指数表示で読み込まれるので、すぐにわかります。

文字コードは基礎的な事ことなので、最初からチェックしています。

EXCELで不具合が起きるという事は、
マイクロソフト系のソフトを使うと全滅の可能性があるのが怖いです。

まったく原因が分からないので、終了ということでありがとうございました。

pass & "¥" & Date & "書き出し.txt"

ここのDateは今日の日付データですね。これのデータ型は「日付型」で、文字列処理に使うと自動的に型変換が行われ、通常、「YYYY/MM/DD」の書式の文字列になります（たとえば「2023/12/27」など）
この結果生成される文字列は

[pass]¥2023/12/27書き出し.txt

のようになります。（[pass]のところは提示がないので適当に読み替えてください）

windowsではファイル名（ファイルパス）に「/」が使えないのでエラーになります
このため、ファイル名として使うためには自前で変換処理を入れる必要があります

「20231227書き出し.txt」というファイル名にしたい

ということならば、Format関数で書式を設定すると良いでしょう

pass & "¥" & Format(Date, "YYYYMMDD") & "書き出し.txt"

お世話になります。
本日改めて試したら問題なく更新できました・・・？？

上手くいかなかった時は、更新しても何も起こらなかったり、備考フィールドが全て喪中に更新されたりと
謎の現象が起こっていました。

とりあえず私が耄碌したのではなさそうでよかったです。(笑)
お騒がせ致しました。

備考フィールドのデータ型は何でしょうか？　本当は何文字ぐらい入っていますか？

SQL自体には問題なさそうです。

うまくいかないとかは、具体的にどのようにうまくいかないのですか。
エラーがでるならそのエラーメッセージを提示してください。
期待の結果にならないのなら、どのような結果になるのか提示ください。

ご連絡ありがとうございます。
やはり対応を待つしかないのですね。。。
色々とありがとうございました！

無事に出来ました。
この度は有り難うございました。

アップデートの弊害だったようですね。
https://cafebreak.hatenablog.com/entry/2023/10/27/075433

アンインストールできないとのことなので、対応を待つしかなさそうですね。
Backup機能を使っている場合はアップデート前に戻す、やどうしてもすぐに改善する必要がある場合はOSを入れ直すのも手っ取り早いかもしれません。

ご連絡ありがとうございます。
再起動や、Officeの修復等行いましたが、改善されませんでした。
Win11のKB5030310適用後、Excelでもコピペでエラーがでるとのサイトを発見しました。
https://answers.microsoft.com/ja-jp/msoffice/forum/all/windows11-kb5030310適用後/8b5c1ebe-312b-4d47-aaf5-7726ae1a1957

時期的にも同じくらいの時期なので、OSの更新プログラムが原因かもしれませんが、
そのプログラムは、すでにアンインストール一覧になく、削除もできません。

リンクテーブルを削除して再作成するようにしました。

なるほどですね。
確認してみると、貼り付けを行いたい場所を選択せずにダブルクリックすると同様のメッセージがでます。
コピーしたい場所をクリックしてからダブルクリックしてはどうでしょうか。

それでも発生する場合は一度OSを再起動でしょうか・・・。

どのOffice（Access、EXCEL他）でも発生する場合は、一度Officeの修復をされてみるのも良いかと思います。

返信ありがとうございます。
VBAではなく、Officeクリップボードを使用した際の不具合です。

https://support.microsoft.com/ja-jp/office/office-クリップボードを使用したコピー-貼り付け-714a72af-1ad4-450f-8708-c2931e73ec8a

個別にレスできずすみません。
回答ありがとうございます。
意味を理解しながら一つずつ試してみたいと思います！

過去に似た感じの質問があるようです。
なにか貼り付けの条件を満たしていないようですね。

https://zawazawa.jp/ms-access/topic/394

またこちらも類似の内容です。
https://hamachan.info/win8/access/mukou.html

Excelのファイル名から日付を取得する

'正規表現のグループ変数による部分置換
Function FindDateX(argStr As String) As Variant
    With CreateObject("VBScript.RegExp")
        .Global = False
        .Pattern = ".*?\((\d{4})\D?(\d{1,2})\D?(\d{1,2})[^)]?(?=\)).*"
        If .Test(argStr) Then
            Dim sDate As String
            sDate = .Replace(argStr, "$1/$2/$3")
            If IsDate(sDate) Then FindDateX = CDate(sDate)
        End If
    End With
End Function

'呼び出し例
Sub Test2()
    Debug.Print FindDateX("C:\Users\中略\発注書(2023.12.19).xls")
    Debug.Print FindDateX("C:\Users\中略\発注書(2023年12月19日).xls")
    Debug.Print FindDateX("C:\Users\中略\発注書(20231219).xls")
    Debug.Print FindDateX("C:\Users\中略\発注書(2023-12-9).xls")
End Sub

クエリを開く時に、任意の日付～日付を抽出することは出来ないでしょうか？

一般機能のパラメータクエリで可能です

SQLの例：

PARAMETERS 抽出開始日 datetime
         , 抽出終了日 datetime;
SELECT * 
FROM テーブル名
WHERE 入荷日 between 抽出開始日 and 抽出終了日
;

Excelのファイル名から日付を取得する

正規表現によるパターンパッチングを行う場合。

Function FindDate(Expression As String) As Variant
    
    FindDate = Null
    
    If Expression = "" Then
        Exit Function
    End If

    Dim objRegExp As Object
    Dim objMatches As Object
    Dim objMatch As Object
    Dim strPattern As String
    Dim strMatchValue As String
    
    Set objRegExp = CreateObject("VBScript.RegExp")
    
    strPattern = "\d+(-|/|\.)\d{1,2}(-|/|\.)\d+"
    
    With objRegExp
        .Pattern = strPattern
        .IgnoreCase = True
        .Global = True
        Set objMatches = .Execute(Expression)
    End With
    
    For Each objMatch In objMatches
        strMatchValue = Replace(objMatch.Value, ".", "/", 1, -1, vbTextCompare)
        If IsDate(strMatchValue) = True Then
            FindDate = CDate(strMatchValue)
            Exit For
        End If
    Next
    
   Set objMatches = Nothing
   Set objRegExp = Nothing

End Function

'呼び出し例
Sub Test1()

    Dim strFullPath As String
    Dim strFileName As String
    
    strFullPath = "C:\Users\中略\発注書(2023-12.19).xls"

    strFileName = Dir(strFullPath)
    
    If strFileName = "" Then
        MsgBox "ファイル'" & strFullPath & "'が見つかりません。", _
               vbExclamation, _
               "ファイル参照エラー"
        Exit Sub
    End If
    
    Dim varDate As Variant
    
    varDate = FindDate(strFileName)

    If IsNull(varDate) Then
        MsgBox "ファイル名'" & strFileName & "'には日付データに変換可能な文字列は含まれていません。", _
               vbExclamation, _
               "ファイル命名規則エラー"
    Else
        MsgBox "ファイル名'" & strFileName & "'から日付 " & Format(varDate, "yyyy/mm/dd") & "を取得しました。", _
               vbInformation, _
               "成功"
    End If

End Function

getFileNameがget file nameっぽくないですねぇ

C:\(データ)\ABC(2023.12.12).xls

とか試してみるといいと思います

先にファイル名を取り出しておくでもいいですが、InStr関数ではなくInStrRev関数を使っておくとより良いと思います

ついでにmidを使わない方法を考えてみたり

Function GetDate(s As String) As Variant
    Dim vTmp As Variant
    Dim sDate As String

    vTmp = Split("(" & Replace(s, ")", "("), "(")
    sDate = Replace(vTmp(UBound(vTmp) - 1), ".", "/")

    If IsDate(sDate) Then GetDate = CDate(sDate)
End Function

手抜きしているのでC:\データ\ABC)2023.12.12(.xlsも日付を拾ってきます

標準モジュールに下記の関数を作成します。

Function GetDate(s As String) As Variant
    Dim pos1 As Long, pos2 As Long, l As Long
    pos1 = InStr(s, "("): pos2 = InStr(s, ")")
    l = pos2 - pos1 - 1
    If l >= 8 Then
        Dim sDate As String
        sDate = Mid(s, pos1 + 1, l)
        sDate = Replace(sDate, ".", "/")
        If IsDate(sDate) Then GetDate = CDate(sDate)
    End If
End Function

発注書取込ボタンのクリック時のイベントプロシージャを下記にします。

Private Sub btn_発注書取込_Click()
    Dim FileName As String
    FileName = getFileName("")
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "T_発注書取込", FileName, True, "発注数$B4:J32"    
    MsgBox "インポート完了", vbInformation + vbOKOnly

   Dim vDate As Variant
   vDate = GetDate(FileName)
   If IsNull(vDate) Then
       MsgBox "ファイル名に日付は含まれてません"
   Else
       MsgBox "日付は" & Format(vDate,"yyyy/mm/dd"), vbInformation + vbOKOnly
   End If
End Sub

取得した日付はとりあえずメッセージボックスに表示してますが、
使用用途に合わせて修正してください。

すみません、自己レスです。
ただ16進数しただけだと考えられます。
検索で見つかる事例で10進と16進が一致しないものもありましたが、
それは転記ミスだと思われました。

お騒がせしました。