VBA Tipp: Datum aus internationalem Datumsstring auslesen.

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Die folgende Funktion bietet die Möglichkeit, aus einem internationalen Datumsstring den Datumswert auszulesen. Dazu ist es notwendig, die Locale ID der Sprachumgebung zu kennen. Nicht aufgeführte Locale IDs kann man z. Bsp. dieser Liste entnehmen, und bei Bedarf die LocaleIDs-Aufzählung im Code ergänzen.

Lösung

Der Code wird in einem globalen Modul gespeichert.

Public Enum LocaleIDs
   de_DE = &H407       ' Deutsch      (Deutschland)
   en_US = &H409       ' Englisch     (USA)
   fl_FI = &H40B       ' Finnisch     (Finnland)
   de_CH = &H807       ' Deutsch      (Schweiz)
   fr_CH = &H100C      ' Französisch  (Schweiz)
   ru_RU = &H419       ' Russisch     (Rußland)
   ' weitere LocalIDs hier ergänzen
End Enum
 
Private Declare PtrSafe Function VarDateFromStr Lib "oleaut32" ( _
   ByVal psDateIn As LongPtr, _
   ByVal lcid As Long, _
   ByVal uwFlags As Long, _
   ByRef dtOut As Date) As Long
 
Private Const S_OK                As Long = 0
Private Const DISP_E_BADVARTYPE   As Long = &H80020008
Private Const DISP_E_OVERFLOW     As Long = &H8002000A
Private Const DISP_E_TYPEMISMATCH As Long = &H80020005
Private Const E_INVALIDARG        As Long = &H80070057
Private Const E_OUTOFMEMORY       As Long = &H8007000E
 
Public Function DateFromString(ByVal sDateIn As String, _
                               ByVal lcid As LocaleIDs) As Date
 
   Dim hRes As Long
 
   ' behält die Standardformatierungseinstellungen für die Ausgabe
   ' Quelle: www.dbwiki.net oder www.dbwiki.de
 
   Const LOCALE_NOUSEROVERRIDE As Long = &H80000000
 
   ' konvertieren
   hRes = VarDateFromStr(StrPtr(sDateIn), lcid, LOCALE_NOUSEROVERRIDE, DateFromString)
 
   ' Ergebnisprüfung
   Select Case hRes
      Case S_OK:
      Case DISP_E_BADVARTYPE:
         Err.Raise 5, , "DateFromString: Schlechter Variablentyp"
      Case DISP_E_OVERFLOW:
         Err.Raise 5, , "DateFromString: Überlauffehler"
      Case DISP_E_TYPEMISMATCH:
         Err.Raise 5, , "DateFromString: Datentypfehler"
      Case E_INVALIDARG:
         Err.Raise 5, , "DateFromString: Ungültiges Argument"
      Case E_OUTOFMEMORY:
         Err.Raise 5, , "DateFromString: Kein Speicherplatz"
      Case Else
         Err.Raise 5, , "DateFromString: Unbekannter Fehlercode (0x" & Hex$(hRes) & ")"
   End Select
End Function

Aufruf

im Direktfenster

   'Konvertiert einen schweizerisch-französischen Datumsstring:
   Debug.Print DateFromString("14 juillet 1789", fr_CH)            'ergibt 14.07.1789
 
   'Konvertiert einen US Datumsstring:
   Debug.Print DateFromString("November 5 1994 8:15:30 pm", en_US) 'ergibt 05.11.1994 20:15:30
   Debug.Print DateFromString("Mar/22/2018 7:44:05 am", en_US)     'ergibt 22.03.2018 07:44:05
 
   'Konvertiert einen russischen Datumsstring:
   Debug.Print DateFromString("3.5.1917", ru_RU)                   'ergibt 03.05.1917
   Debug.Print DateFromString(" 23 2 2018 ", ru_RU)                'ergibt 23.02.2018