'Attribute VB_Name = "mdl_dateUSUK"
'Prüfung Anlegen Pfad Unterverzeichniss'
Option Explicit
' ---------------------------------------------------------
' Funktion: dateUSUK
' Funktion zur Umwandlung eines Datums in einen String im
' US - oder UK - Format
' Eingestellt von: Andre Schau
' Datum: 5. Juno 2006
' Kommentar:
' Parameter: datMyDate = Datum (auch als String moeglich)
' boDateUS = Trigger fuer US oder UK,
' datMyTime = Zeit, kleinste Einheit Sekunde,
' boMyTime = Trigger fuer Zeitausgabe,
' boShort = Trigger fuer kurze Ausgabe
' Rückgabe: Fehlernummer
' Aufruf:
Sub test_dateUSUK()
Dim err_nr As Long
Dim strMyDate As String
strMyDate = ""
'1. Ausgabe Datum und Zeit im US-Format
err_nr = dateUSUK("24.04.2010  17:56:32", strMyDate)
MsgBox strMyDate
'2. Ausgabe Datum und Zeit im US-Format - wie 1.
err_nr = dateUSUK("24.04.2010", strMyDate, , "17:56:32")
MsgBox strMyDate
'3. Ausgabe nur Datum im UK-Format
err_nr = dateUSUK("24.04.2010", strMyDate, False, , False)
MsgBox strMyDate
End Sub
' ---------------------------------------------------------
Function dateUSUK(datMyDate As Date, strMyDate As String, _
                  Optional boDateUS As Boolean = True, _
                  Optional datMyTime As Date, _
                  Optional boMyTime As Boolean = True, _
                  Optional boShort As Boolean = TrueAs Long
'Funktion zur Umwandlung eines Datums in einen String im
'US - oder UK - Format
'UK:all-numeric date (e.g., "31/12/99")
'US:all-numeric date (e.g., "12/31/99")
'Uebergabeparameter: datMyDate = Datum (auch als String moeglich),
'boDateUS = Trigger fuer US oder UK,
'datMyTime = Zeit, kleinste Einheit Sekunde,
'boMyTime = Trigger fuer Zeitausgabe,
'boShort = Trigger fuer kurze Ausgabe

'Variablendeklarationen
'String
Dim strTimeForm As String
'Bei Fehler zur Fehlerbehandlung springen
On Error Goto errorhandler
'Wenn der Datumswert verschieden vom übergebenen Datum ist und
'keine Zeit übergeben wurde, steht die zeit wahrscheinlich beim Datum
If DateValue(datMyDate) <> datMyDate And datMyTime = 0 Then
  'Zeit übernehmen
  datMyTime = TimeValue(datMyDate)
'Ende Wenn der Datumswert ...
End If

'wenn kurzes Format, dann
If boShort Then
  'wenn US-Format, dann
  If boDateUS Then
    strMyDate = Month(datMyDate) & "/" & Day(datMyDate) & "/" & Year(datMyDate)
  'oder wenn nicht US-Format,
  Else
    strMyDate = Day(datMyDate) & "/" & Month(datMyDate) & "/" & Year(datMyDate)
  'Ende wenn US-Format, dann
  End If
  'String fuer Stundenformat kurz
  strTimeForm = "h:m:s"
'oder wenn nicht kurzes Format,
Else
  'wenn US-Format, dann
  If boDateUS Then
    strMyDate = Format(datMyDate, "MM") & "/" & Format(datMyDate, "DD") & "/" & _
       Format(datMyDate, "YYYY")
  'oder wenn nicht US-Format,
  Else
    strMyDate = Format(datMyDate, "DD") & "/" & Format(datMyDate, "MM") & "/" & _
       Format(datMyDate, "YYYY")
  'Ende wenn US-Format, dann
  End If
  'String fuer Stundenformat lang
  strTimeForm = "hh:mm:ss"
'Ende wenn kurzes Format, dann
End If

'Wenn boMyTime, dann Zeit dazu
'beachte: 2 Leerzeichen zwischen Datum und Zeit!
If boMyTime Then strMyDate = strMyDate & "  " & Format(datMyTime, strTimeForm)

'eventuelle Fehler loeschen
Err.Clear
'Fehlerbehandlung
errorhandler:
'Uebernahme Fehlernummer
dateUSUK = Err.Number
End Function