VBA 根据日期字符串 返回日期格式（只能识别部分常用格式）

'主程序入口
Sub MainTest()
    Debug.Print GetDateFormat("20240101")               ' YYYYMMDD
    Debug.Print GetDateFormat("2024-01-01")            ' YYYY-MM-DD
    Debug.Print GetDateFormat("2024/01/01")            ' YYYY/MM/DD
    Debug.Print GetDateFormat("2024-01-01 12:30:45")   ' YYYY-MM-DD HH24:MI:SS
    Debug.Print GetDateFormat("2024/01/01 12:30:45")   ' YYYY/MM/DD HH24:MI:SS
    
    Debug.Print GetDateFormat("2024-01-01 12:30")   ' YYYY-MM-DD HH24:MI
    Debug.Print GetDateFormat("2024/01/01 12:30")   ' YYYY/MM/DD HH24:MI
    
    Debug.Print GetDateFormat("2024-01-01 12")   ' YYYY-MM-DD HH24
    Debug.Print GetDateFormat("2024/01/01 12")   ' YYYY/MM/DD HH24
    
    Debug.Print GetDateFormat("01/01/2024")   ' MM/DD/YYYY
    Debug.Print GetDateFormat("01-01-2024")   ' MM-DD-YYYY
    
    Debug.Print GetDateFormat("2024-01-01 2:30:45")    ' YYYY-MM-DD HH24:MI:SS
    Debug.Print GetDateFormat("2024-01-01 12:3:45")    ' YYYY-MM-DD HH24:MI:SS
    Debug.Print GetDateFormat("2024-01-01 12:30:5")    ' YYYY-MM-DD HH24:MI:SS
    
    Debug.Print GetDateFormat("20240101123045")        ' YYYYMMDDHH24MISS
    Debug.Print GetDateFormat("InvalidDate")           ' Unknown format
End Sub

Function GetDateFormat(inputStr As String) As String
    Dim fmt As String
    
    ' 判断是否包含空格（即是否包含时间部分）
    If InStr(inputStr, " ") > 0 Then
        ' 包含空格，说明是带时间的日期格式
        If InStr(inputStr, "-") > 0 Then
            ' 格式：YYYY-MM-DD HH24:MI:SS 或 YYYY-MM-DD HH24:MI
            If CheckFormatWithTime(inputStr, "-", "YYYY-MM-DD HH24:MI:SS") Then
                fmt = "YYYY-MM-DD HH24:MI:SS"
            ElseIf CheckFormatWithTime(inputStr, "-", "YYYY-MM-DD HH24:MI") Then
                fmt = "YYYY-MM-DD HH24:MI"
            ElseIf CheckFormatWithTime(inputStr, "-", "YYYY-MM-DD HH24") Then
                fmt = "YYYY-MM-DD HH24"
            End If
        ElseIf InStr(inputStr, "/") > 0 Then
            ' 格式：YYYY/MM/DD HH24:MI:SS 或 YYYY/MM/DD HH24:MI
            If CheckFormatWithTime(inputStr, "/", "YYYY/MM/DD HH24:MI:SS") Then
                fmt = "YYYY/MM/DD HH24:MI:SS"
            ElseIf CheckFormatWithTime(inputStr, "/", "YYYY/MM/DD HH24:MI") Then
                fmt = "YYYY/MM/DD HH24:MI"
            ElseIf CheckFormatWithTime(inputStr, "/", "YYYY/MM/DD HH24") Then
                fmt = "YYYY/MM/DD HH24"
            End If
        End If
    Else
        ' 不包含空格，可能是紧凑格式或仅日期格式
        If InStr(inputStr, "-") > 0 Then
            ' 格式：YYYY-MM-DD 或 MM-DD-YYYY
            If CheckFormatWithoutTime(inputStr, "-", "YYYY-MM-DD") Then
                fmt = "YYYY-MM-DD"
            ElseIf CheckFormatWithoutTime(inputStr, "-", "MM-DD-YYYY") Then
                fmt = "MM-DD-YYYY"
            End If
        ElseIf InStr(inputStr, "/") > 0 Then
            ' 格式：YYYY/MM/DD 或 MM/DD/YYYY
            If CheckFormatWithoutTime(inputStr, "/", "YYYY/MM/DD") Then
                fmt = "YYYY/MM/DD"
            ElseIf CheckFormatWithoutTime(inputStr, "/", "MM/DD/YYYY") Then
                fmt = "MM/DD/YYYY"
            End If
        ElseIf Len(inputStr) = 8 Then
            ' 格式：YYYYMMDD
            If CheckFormatYYYYMMDD(inputStr) Then
                fmt = "YYYYMMDD"
            End If
        ElseIf Len(inputStr) = 14 Then
            ' 格式：YYYYMMDDHH24MISS
            If CheckFormatYYYYMMDDHH24MISS(inputStr) Then
                fmt = "YYYYMMDDHH24MISS"
            End If
        End If
    End If
    
    ' 如果没有匹配到任何格式，返回未知格式
    If fmt = "" Then
        fmt = "Unknown format"
    End If
    
    GetDateFormat = fmt
End Function

' 检查带时间部分的格式
Private Function CheckFormatWithTime(s As String, separator As String, formatModel As String) As Boolean
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    
    Select Case formatModel
        Case "YYYY-MM-DD HH24:MI:SS", "YYYY/MM/DD HH24:MI:SS"
            regex.pattern = "^\d{4}" & separator & "(0?[1-9]|1[0-2])" & separator & "(0?[1-9]|[12]\d|3[01]) ([01]?\d|2[0-3]):([0-5]?\d):([0-5]?\d)$"
        Case "YYYY-MM-DD HH24:MI", "YYYY/MM/DD HH24:MI"
            regex.pattern = "^\d{4}" & separator & "(0?[1-9]|1[0-2])" & separator & "(0?[1-9]|[12]\d|3[01]) ([01]?\d|2[0-3]):([0-5]?\d)$"
        Case "YYYY-MM-DD HH24", "YYYY/MM/DD HH24"
            regex.pattern = "^\d{4}" & separator & "(0?[1-9]|1[0-2])" & separator & "(0?[1-9]|[12]\d|3[01]) ([01]?\d|2[0-3])$"
    End Select
    
    CheckFormatWithTime = regex.Test(s)
End Function

' 检查不带时间部分的格式
Private Function CheckFormatWithoutTime(s As String, separator As String, formatModel As String) As Boolean
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    
    Select Case formatModel
        Case "YYYY-MM-DD", "YYYY/MM/DD"
            regex.pattern = "^\d{4}" & separator & "(0?[1-9]|1[0-2])" & separator & "(0?[1-9]|[12]\d|3[01])$"
        Case "MM-DD-YYYY", "MM/DD/YYYY"
            regex.pattern = "^(0?[1-9]|1[0-2])" & separator & "(0?[1-9]|[12]\d|3[01])" & separator & "\d{4}$"
    End Select
    
    CheckFormatWithoutTime = regex.Test(s)
End Function

' 检查格式：YYYYMMDD
Private Function CheckFormatYYYYMMDD(s As String) As Boolean
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.pattern = "^\d{4}(0[1-9]|1[0-2])(0[1-9]|[12]\d|3[01])$"
    CheckFormatYYYYMMDD = regex.Test(s)
End Function

' 检查格式：YYYYMMDDHH24MISS
Private Function CheckFormatYYYYMMDDHH24MISS(s As String) As Boolean
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.pattern = "^\d{4}(0[1-9]|1[0-2])(0[1-9]|[12]\d|3[01])([01]\d|2[0-3])([0-5]\d)([0-5]\d)$"
    CheckFormatYYYYMMDDHH24MISS = regex.Test(s)
End Function

输入内容如下：

运行结果如下：