Private Function ExtractNums7913(expression As String) As String
    Dim a() As Byte
    Dim b() As Byte
    Dim ct As Long
        a = expression
        b = a
        For x = 0 To UBound(a) Step 2
            If a(x) < 58 Then
                If a(x) > 47 Then
                    b(ct + ct) = a(x)
                    ct = ct + 1
                End If
            End If
        Next
        ReDim Preserve b(ct + ct)
        ExtractNums7913 = b
End Function

Private Function IsDate_7913_v2(str As String) As Boolean
On Error GoTo Fin
Dim Partes(2) As Long
Dim Primer() As String
    Primer = Split(str, "/")
    If UBound(Primer) <> 2 Then GoTo Fin
    Partes(0) = Primer(0): Partes(1) = Primer(1): Partes(2) = Primer(2)
    If Partes(2) > 9999 Then GoTo Fin
    Select Case Partes(1) 'verificamos el mes
        Case 0
            GoTo Fin
        Case 1, 3, 5, 7, 8, 10, 12 'si es de 31 dias
            Select Case Partes(0) 'verificamos el dia
                Case Is > 31
                    GoTo Fin 'si es mayor que 31 es false
                Case Is < 1
                    GoTo Fin 'si es menor que 1 es false
                Case Else
                    IsDate_7913_v2 = True : GoTo Fin 'sino true
            End Select
        Case 4, 6, 9, 11 'si es de 30 dias
            Select Case Partes(0)
                Case Is > 30
                    GoTo Fin
                Case Is < 1
                    GoTo Fin
                Case Else
                    IsDate_7913_v2 = True : GoTo Fin 
            End Select
        Case 2 'si es febrero
            Select Case Partes(0)
                Case Is > 29 'si es mayor que 29
                    GoTo Fin
                Case Is < 1 ' si es menor a 1
                    GoTo Fin
                Case 29
                    If Partes(2) Mod 4 = 0 Then
                        If Partes(2) Mod 100 = 0 Then
                            If Partes(2) Mod 400 = 0 Then IsDate_7913_v2 = True 'si es biciesto multiplo de 100 y 400
                        Else
                            IsDate_7913_v2 = True : GoTo Fin  'si es biciesto
                        End If
                    End If
                Case Else
                    IsDate_7913_v2 = True : GoTo Fin 
            End Select
        End Select
Fin:
End Function

Public Function IsDate_r338(ByVal str As String) As Boolean
If str = vbNullString Then Exit Function
    Dim strp As Long
    strp = StrPtr(str)
If lstrlenW(strp) <> 10 Then Exit Function
 
    Dim j As Long, k As Long, dia As Long, mes As Long, año As Long, jp As Long
 
    jp = VarPtr(j)
    For k = 0 To 18 Step 2
        Call RtlMoveMemory(jp, strp + k, 1)
        Select Case k / 2
            Case 0
                If j < 48 And j > 51 Then Exit Function
                dia = (j - 48) * 10
            Case 1
                If j < 48 And j > 57 Then Exit Function
                dia = dia + (j - 48)
                If dia = 0 Or dia > 31 Then Exit Function
            Case 2, 5: If j <> 47 Then Exit Function
            Case 3
                If j <> 48 And j <> 49 Then Exit Function
                mes = (j - 48) * 10
            Case 4
                If j < 48 And j > 57 Then Exit Function
                mes = mes + (j - 48)
                If mes = 0 Or mes > 12 Then Exit Function
                If Not (mes = 1 Or mes = 3 Or mes = 5 Or mes = 7 Or mes = 8 Or mes = 10 Or mes = 12) And dia = 31 Then Exit Function
                If mes = 2 And dia > 29 Then Exit Function
            Case 6
                If j < 48 And j > 57 Then Exit Function
                año = (j - 48) * 1000
            Case 7
                If j < 48 And j > 57 Then Exit Function
                año = año + (j - 48) * 100
            Case 8
                If j < 48 And j > 57 Then Exit Function
                año = año + (j - 48) * 10
            Case 9
                If j < 48 And j > 57 Then Exit Function
                año = año + (j - 48)
 
                If mes = 2 And dia = 29 Then If Not (año Mod 4 = 0 And Not (año Mod 100 = 0 And año Mod 400 <> 0)) Then Exit Function
        End Select
    Next
    IsDate_r338 = True
End Function

Public Function DeleteString7913(ByVal sString As String, ByVal PosComienzo As Long, ByVal Longitud As Long) As String
    DeleteString7913 = LeftB$(sString, PosComienzo + PosComienzo) & RightB$(sString, LenB(sString) - (PosComienzo + PosComienzo + Longitud + Longitud))
End Function