Function R100(XXX As String) As Boolean
Dim X() As String
 
X = Split(XXX, ":")
If (CInt(X(0)) < 24) And (CInt(X(1) < 60)) And (CInt(X(2) < 60)) Then R100 = True
End Function
 

 
Option Explicit
 
Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal pDst As Long, ByVal pSrc As Long, ByVal ByteLen As Long)
 
'   //  Formato aceptado   HH:MM:SS, H:/MM:S, HH:MM:S, etc!¡.
Public Function isHour_BlackZX(ByRef sStr As String, Optional bExtrictic As Boolean = True) As Boolean
Dim lChar           As Long
Dim lVal            As Long
Dim lConvert(2)     As Long
 
Dim lDim            As Long
Dim lMult           As Long
Dim pStr            As Long
Dim pChar           As Long
 
    pStr = LenB(sStr)
    If (bExtrictic) Then
        If Not (pStr = &H10) Then Exit Function
    ElseIf (pStr < &H5) And (pStr <= &H8) Then
        Exit Function
    End If
 
    pStr = StrPtr(sStr) + (pStr - &H2)
    pChar = VarPtr(lChar)
 
    lDim = &H2
    lMult = &H1
    lConvert(lDim) = &H0
 
    Do Until StrPtr(sStr) > pStr
        RtlMoveMemory pChar, pStr, &H2  '   //  Dos bytes = char...
        lVal = (lChar And &HFF)
        If (lVal = &H3A) Then
            lDim = (lDim - &H1)
            If ((lDim And &H80000000) = &H80000000) Then Exit Function
            lMult = &H1
        Else
            If ((lVal > &H39) Or (lVal < &H30)) Then Exit Function
            lConvert(lDim) = lConvert(lDim) + ((lVal - &H30) * lMult)
            lMult = (lMult * &HA)
        End If
        pStr = (pStr - &H2)
    Loop
 
    If (lConvert(&H0) > &H17) Or (lConvert(&H1) > &H3B) Or (lConvert(&H2) > &H3B) Then Exit Function
 
    isHour_BlackZX = True
 
End Function
 
Private Sub Form_Load()
    MsgBox isHour_BlackZX("23:59:9") & vbCrLf & _
           isHour_BlackZX("23:59:9", False)
End Sub
 
 

 
Dim lMult           As Long
Dim pStr            As Long
Dim pChar           As Long
 
    pStr = LenB(sStr)
    If (bExtrictic) Then
        If Not (pStr = &H8) Then Exit Function    ElseIf (pStr < &H5) And (pStr <= &H8) Then
        Exit Function
    End If
 
 

(sé que se puede simplificar código con bucles, pero yo lo elijo hacer así  )

'//En un módulo de clase.

Option Explicit
Private Declare Sub PutMem4 Lib "msvbvm60.dll" (ByVal Ptr&, ByVal Value&)
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long
 
Private lngAscHeader&(5), intAsc%()
 
Public Static Function IsHour_Psyke12(ByRef sHour$) As Boolean
    If LenB(sHour) = 16 Then
        lngAscHeader(3) = StrPtr(sHour)
 
        '//Check ":"
        If intAsc(2) = 58 And intAsc(5) = 58 Then
            '//Hours
            If intAsc(0) < 48 Or intAsc(0) > 50 Then Exit Function
 
            If intAsc(1) < 48 Then Exit Function
            If intAsc(0) = 50 Then
                If intAsc(1) > 51 Then Exit Function
            Else
                If intAsc(1) > 57 Then Exit Function
            End If
 
            '//Minutes
            If intAsc(3) < 48 Or intAsc(3) > 53 Then Exit Function
            If intAsc(4) < 48 Or intAsc(4) > 57 Then Exit Function
 
            '//Seconds
            If intAsc(6) < 48 Or intAsc(6) > 53 Then Exit Function
            If intAsc(7) < 48 Or intAsc(7) > 57 Then Exit Function
 
            IsHour_Psyke12 = True
        End If
    End If
End Function
 
Private Sub Class_Initialize()
    lngAscHeader(0) = 1
    lngAscHeader(1) = 2
    lngAscHeader(4) = &H7FFFFFFF
    PutMem4 VarPtrArray(intAsc), VarPtr(lngAscHeader(0))
End Sub
 
Private Sub Class_Terminate()
    PutMem4 VarPtrArray(intAsc), 0
End Sub

Option Explicit
 
Private Sub Form_Load()
Dim c As New Class1
 
    Debug.Print String$(50, "=")
    Debug.Print c.IsHour_Psyke12(Time$)      'True
    Debug.Print c.IsHour_Psyke12("23:59:59") 'True
    Debug.Print c.IsHour_Psyke12("00:00:00") 'True
    Debug.Print c.IsHour_Psyke12("34:54:13") 'False
    Debug.Print c.IsHour_Psyke12("14:64:24") 'False
    Debug.Print c.IsHour_Psyke12("22:07:70") 'False
    
Set c = Nothing
End Sub

(no creo que sea muy rápida, tan solo doy más opciones...   )

'//En un módulo de clase.

Option Explicit
Private oRegExp As Object
 
Public Static Function IsHour_Psyke13(ByRef sHour$) As Boolean
    IsHour_Psyke13 = oRegExp.Test(sHour)
End Function
 
Private Sub Class_Initialize()
    Set oRegExp = CreateObject("VBScript.RegExp")
    With oRegExp
        .Pattern = "^([01]\d|2[0-3])\:[0-5]\d\:[0-5]\d$"
        .Global = True
    End With
End Sub
 
Private Sub Class_Terminate()
    Set oRegExp = Nothing
End Sub

Option Explicit
 
Private Sub Form_Load()
Dim c As New Class1
 
    Debug.Print String$(50, "=")
    Debug.Print c.IsHour_Psyke13(Time$)      'True
    Debug.Print c.IsHour_Psyke13("23:59:59") 'True
    Debug.Print c.IsHour_Psyke13("00:00:00") 'True
    Debug.Print c.IsHour_Psyke13("34:54:13") 'False
    Debug.Print c.IsHour_Psyke13("14:64:24") 'False
    Debug.Print c.IsHour_Psyke13("22:07:70") 'False
    
Set c = Nothing
End Sub

Option Explicit
 
Public Static Function IsHour_Psyke14(ByRef sHour$) As Boolean
Dim h As Byte, m As Byte, s As Byte
On Error GoTo NoHour:
    If LenB(sHour) = 16 Then
        If InStrB(1, ":", MidB$(sHour, 5, 2), vbBinaryCompare) = 0 Then Exit Function
        If InStrB(1, ":", MidB$(sHour, 11, 2), vbBinaryCompare) = 0 Then Exit Function
 
        h = LeftB$(sHour, 4) + 0
        If h > 23 Then Exit Function
        m = MidB$(sHour, 7, 4) + 0
        If m > 59 Then Exit Function
        s = RightB$(sHour, 4) + 0
        If s > 59 Then Exit Function
 
        IsHour_Psyke14 = True
    End If
    Exit Function
NoHour:
End Function

Option Explicit
 
Private Sub Form_Load()
    Debug.Print String$(50, "=")
    Debug.Print IsHour_Psyke14(Time$)      'True
    Debug.Print IsHour_Psyke14("23:59:59") 'True
    Debug.Print IsHour_Psyke14("00:00:00") 'True
    Debug.Print IsHour_Psyke14("34:54:13") 'False
    Debug.Print IsHour_Psyke14("14:64:24") 'False
    Debug.Print IsHour_Psyke14("22:04:70") 'False
End Sub