VB-Tec.de Visual Basic - Technik, FAQ, Tricks, Beispiele

Mit der folgenden Funktion wird ein gegebener Datumstring auf Korrektheit geprüft. Dabei werden auch Kurzeingaben wie "31121999" oder unvollständige Eingaben wie "31.12" versucht zu analysieren. Die Funktion gibt einen Leerstring zurück, falls das übergebene Datum nicht korrekt ist, ansonsten einen formatierten Datumsstring.

Public Function DateFormat( _
    ByVal Datum As String, _
    Optional Formatierung As String = "dd.mm.yyyy" _
  ) As String
  
  'Deklarationen:
  Dim Tag As Long
  Dim Monat As Long
  Dim Jahr As Long
  Dim i As Long
  
  'Datum trimmen:
  Datum = Trim$(Datum)
  If Datum = "" Then Exit Function
  
  'Format normieren:
  Datum = Replace(Trim$(Datum), ":", ".")
  Datum = Replace(Trim$(Datum), ",", ".")
  
  'Tag:
  i = InStr(Datum, ".")
  If i Then
    Tag = Val(Left$(Datum, i - 1))
    Datum = Mid$(Datum, i + 1)
  Else
    Tag = Val(Left$(Datum, 2))
    Datum = Mid$(Datum, 3)
  End If
  If Tag = 0 Then Exit Function
  
  'Monat:
  i = InStr(Datum, ".")
  If i Then
    Monat = Val(Left$(Datum, i - 1))
    Datum = Mid$(Datum, i + 1)
  Else
    Monat = Val(Left$(Datum, 2))
    Datum = Mid$(Datum, 3)
  End If
  If Monat = 0 Then
    'Aktuellen Monat berücksichtigen:
    Monat = Month(Now)
    If Tag < Day(Now) Then Monat = Monat + 1
  End If
  
  'Jahr:
  Jahr = Val(Datum)
  If Jahr = 0 Then
    'Aktuelles Jahr berücksichtigen:
    Jahr = Year(Now)
    If DateSerial(Jahr, Monat, Tag) < Now Then Jahr = Jahr + 1
  ElseIf Jahr < 100 Then
    'Aktuelles Jahrhundert berücksichtigen:
    Jahr = (Year(Now) \ 100) * 100 + Jahr
  End If
  
  On Error Resume Next
  DateFormat = Format$(DateSerial(Jahr, Monat, Tag), Formatierung)
End Function

Übrigens: Benutzen Sie die schnelle Replace-Funktion, falls Sie noch mit einer VB-Version kleiner als 6 arbeiten.

Hier ein Beispiel zur Nutzung der DateFormat-Funktion:

Private Sub txtDatum_LostFocus()
  Dim Datum As String
  
  Datum = DateFormat(txtDatum.Text)
  If Datum <> txtDatum.Text Then
    'Datum wurde umformatiert:
    If Len(Datum) Then
      'Datum war korrekt:
      txtDatum.Text = Datum
    Else
      'Datum ist fehlerhaft:
      Beep
      txtDatum.SetFocus
    End If
  End If
End Sub