Hallo
Sorry,... der Fehler war in der "Case 8" Anweisung, da habe ich die Daten falsch extrahiert.
Zusätzlich habe ich die "Case 9" Anweisung noch erweitert.
Sollte jetzt funktionieren
Function Check_Date(chkDate As String) As Boolean
Dim i As Byte
Dim tmp As String
'Nur damit es nachher kürzer zu schreiben ist :-)
tmp = chkDate
Select Case Len(tmp)
Case 10
'Format = 01.01.2007
'Prüfen ob Punkte richtig gesetzt sind
If Mid(tmp, 3, 1) = "." And Mid(tmp, 6, 1) = "." Then
'Monatsprüfun
Select Case Val(Mid(tmp, 4, 2))
'Monate prüfen
Case 1, 3, 5, 7, 8, 10, 12
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 31 Then
Check_Date = True
Exit Function
End If
Case 4, 6, 9, 11
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 30 Then
Check_Date = True
Exit Function
End If
Case 2
'Das Jahr 2000 Problem wird hier nicht berücksichtigt
'Kein Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 <> 0 Then
Check_Date = True
Exit Function
End If
'Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 = 0 Then
Check_Date = True
Exit Function
End If
End Select
End If
Case 9
'Format = 1.09.2007 oder 15.1.2007
'Prüfen ob Punkte richtig gesetzt sind
If Mid(tmp, 2, 1) = "." And Mid(tmp, 5, 1) = "." Then
'Monatsprüfung
Select Case Val(Mid(tmp, 3, 2))
'Monate prüfen
Case 1, 3, 5, 7, 8, 10, 12
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 31 Then
Check_Date = True
Exit Function
End If
Case 4, 6, 9, 11
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 30 Then
Check_Date = True
Exit Function
End If
Case 2
'Das Jahr 2000 Problem wird hier nicht berücksichtigt
'Kein Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 <> 0 Then
Check_Date = True
Exit Function
End If
'Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 = 0 Then
Check_Date = True
Exit Function
End If
End Select
End If
If Mid(tmp, 3, 1) = "." And Mid(tmp, 5, 1) = "." Then
'Monatsprüfung
Select Case Val(Mid(tmp, 4, 2))
'Monate prüfen
Case 1, 3, 5, 7, 8, 10, 12
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 31 Then
Check_Date = True
Exit Function
End If
Case 4, 6, 9, 11
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 30 Then
Check_Date = True
Exit Function
End If
Case 2
'Das Jahr 2000 Problem wird hier nicht berücksichtigt
'Kein Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 <> 0 Then
Check_Date = True
Exit Function
End If
'Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 = 0 Then
Check_Date = True
Exit Function
End If
End Select
End If
Case 8
'Format = 1.1.2007
'Prüfen ob Punkte richtig gesetzt sind
If Mid(tmp, 3, 1) = "." And Mid(tmp, 6, 1) = "." Then
'Monatsprüfung
Debug.Print Val(Mid(tmp, 4, 2))
Select Case Val(Mid(tmp, 4, 2))
'Monate prüfen
Case 1, 3, 5, 7, 8, 10, 12
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 31 Then
Check_Date = True
Exit Function
End If
Case 4, 6, 9, 11
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 30 Then
Check_Date = True
Exit Function
End If
Case 2
'Das Jahr 2000 Problem wird hier nicht berücksichtigt
'Kein Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 <> 0 Then
Check_Date = True
Exit Function
End If
'Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 4)) Mod 4 = 0 Then
Check_Date = True
Exit Function
End If
End Select
End If
Case 6
'Format = 1.1.07
'Prüfen ob Punkte richtig gesetzt sind
If Mid(tmp, 2, 1) = "." And Mid(tmp, 4, 1) = "." Then
'Monatsprüfung
Select Case Val(Mid(tmp, 3, 1))
'Monate prüfen
Case 1, 3, 5, 7, 8, 10, 12
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 31 Then
Check_Date = True
Exit Function
End If
Case 4, 6, 9, 11
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 30 Then
Check_Date = True
Exit Function
End If
Case 2
'Das Jahr 2000 Problem wird hier nicht berücksichtigt
'Kein Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 2)) Mod 4 <> 0 Then
Check_Date = True
Exit Function
End If
'Schaltjahr
If Val(Left(tmp, 2)) >= 1 And Val(Left(tmp, 2)) <= 28 And Val(Right(tmp, 2)) Mod 4 = 0 Then
Check_Date = True
Exit Function
End If
End Select
End If
Case Else
Check_Date = False
End Select
End Function
Gruss Rainer