Microsoft Access 掲示板

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

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

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

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も日付を拾ってきます

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

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

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