User Tools

Site Tools


vba:classes:date:datetime:index

[VBA] DateTime

Version 1.10.0 04.07.2016

Die Klasse DateTime beinhaltet alle Möglichen Funktionen rund um das Datum.

Datumsrechnungen in VBA sind eine Kunst für sich. Viele Funktionen, die man aus anderen Sprachen kennt, fehlen gänzlich. Das endet damit, dass die meisten Datumsrechnungen irgendwie zusammengebastelt werden müssen. Darum habe ich in Anlehnung zu PHP die Klassen DateTime und DateInterval erstellt. Diese Seite befasst sich mit der Klasse DateTime.

Die Klasse hat versteckte Attribute. Damit diese aktiv übernommen werden reicht es nicht aus, den Code in eine neue Klasse zu kopieren. Man muss die Klasse aus der Datei nach VBA importieren.
Bild zum Import

Download datetime.cls (V-1.10.0)

Mit der Version 1.8.0 wurde das Verhalten des Paramters Allgemein: Rückgabeparamter iByRef (Rückgabewert) verändert. Neu ist er Standardmässig auf True und nicht mehr auf False. Falls das nicht gewünscht ist, kann man die Konstante C_DEFAULT_BYREF auf False umstellen

Abhängigkeiten

Die Klasse [VBA] DateInterval muss ebenfalls installiert sein: dateinterval.cls

Die ganze Geschichte mit Zeitzonen ist noch nicht umgesetzt. Wird sicher lustig mit der Nordkoreanischen Halbstundenversetzung.

Zusätzlich kann mit dem Interface [VBA] IFormattable gearbeitet werden. Über die Systemvariable IFormattable_exists kann das Interface dazugeschlatet werden.

Settings / Systemvariablen

Ãœber 2 Systemvariablen kann der Code der Umgebung angepasst werden.

  • IFormattable_exists (Boolean) Mit dieser Variabel kann das Interface [VBA] IFormattable dazu geschaltet werden.
  • isAccess (Boolean) Falls der Code in Excel oder Word verwednet werden soll, muss diese Variabel auf False gesetzt werden, damit die Funktion NZ() dazugeschaltet wird

Definitionen

Für die Ausgabe der Resultate verwendete ich die Funktion print_r() bzw. d().

Creatoren

Es gibt verschiedene Möglichkeiten ein DateTime zu initialisieren

Methode Rückgabetyp Beschreibung
construct DateTime Initialisiert ein bestehendes Objekt neu
instance DateTime Erstellt eine neue Instance
serial DateTime Setzt Datum und Zeit. Entspricht DateSerial() + TimeSreial()

Methoden

Methode Rückgabetyp Beschreibung
add DateTime Rechnet ein DateInterval zum Datum hinzu
addSingleValue DateTime Rechnet ein einzelnen Part hinzu
clone DateTime Erstellt eine Kopie des DateTime Objektes
diff DateInterval Gibt die Differenz als DateInterval zu einem Datum zurück
format String Gibt ein formatiertes Datum zurück → VBA.format()
minus DateTime Zählt ein DateInterval vom Datum ab
trunc DateTime Schneidet Den Hinteren Teil des Timestamps ab
round DateTime Rundet den Timestamp
modify DateTime Ändern eines speziellen Wertes
interval Array Erstellt eine Serie von Daten anhand eines Intervals
setProperty DateTime Setzt ein Property ung gibt ein DateTime zurück
toString String Gibt das Objekt als String zurück

Properties

Ich unterscheide hier zwischen Properties und Attribute. Attribute haben direkt mit den Datum/Zeit zu tun, die Properties steuern das Verhalten der Klasse

Property Rückgabetyp Get/Set Beschreibung
returnType dtReturnTypes Get/Set Bei gewissen Methoden kann man das Rückgabetype auswählen
sqlDateFormatString String Get SQL Formatstring
toString String Get Datum als String im sql/vba Format. Analog zum Attribut sqlTimeStamp. Wird im Interface IFormatter wieder verwendet

Attribute

Alle Attribute sind les- und schreibbar
Attribut Rückgabetyp Beschreibung Format
dateValue Variant Nur Datum
day Integer Tage D oder DD 1)
dayOfWeek Integer Tag in der Woche W
dayOfYear Long Tag im Jahr Y
firstDayOfWeek VbDayOfWeek Definition: Erste Woche im Jahr
firstWeekOfYear VbFirstWeekOfYear Definition: Erster Tag in der Woche
hour Integer Stunden H oder HH 2)
minute Integer Minuten N oder NN 3)
microSecond Long Mikrosekunden
milliSecond Long Millisekunden
month Integer Monat M oder MM 4)
nanoSecond Variant Nanosekunden F
patternDelemiter String*1 Optionales Trennzeichen bei unklaren Pattern für. Standard: @
second Integer Sekunde S oder SS 5)
timestamp Date Ganzes Datum inkl. Zeit
timeValue Variant Nur Zeit
week Long Woche im Jahr WW
year Integer Jahr YY oder YYYY 6) 2016
sqlDate String Datum im SQL-Formtat #MM/DD/YYYY# oder #YYYY-MM-DD#
sqlTime String Zeit im SQL-Formtat #HH:NN:SS#
sqlTimestamp String Timestamp im SQL-Formtat #MM/DD/YYYY HH:NN:SS# oder #YYYY-MM-DD HH:NN:SS#

Beispiel für die Werte

print_r DateTime("2016-03-02 11:36:42.0123456", "YYYY-MM-DD HH:NN:SS.F")
<Class Module::DateTime>  (
    [timestamp] => <Date> 02.03.2016 11:36:42
    [dateValue] => <Date> 02.03.2016
    [timeValue] => <Date> 11:36:42
    [year] => <Integer> 2016
    [month] => <Integer> 3
    [monthName] => <String> 'März'
    [day] => <Integer> 2
    [hour] => <Integer> 11
    [minute] => <Integer> 36
    [second] => <Integer> 42
    [nanoSecond] => <Double> 12345600
    [microSecond] => <Long> 12346
    [milliSecond] => <Long> 12
    [firstWeekOfYear] => <Long> 0
    [firstDayOfWeek] => <Long> 0
    [patternDelemiter] => <String> '@'
    [dayOfWeek] => <Integer> 3
    [quarter] => <Integer> 1
    [week] => <Integer> 9
    [dayOfWeekName] => <String> 'Mittwoch'
    [dayOfYear] => <Long> 62
    [sqlTimeStamp] => <String> '#2016-03-02 11:36:42#'
    [sqlDate] => <String> '#2016-03-02#'
    [sqlTime] => <String> '#11:36:42#'
    [sqlFormat] => <Long> 16
    [returnType] => <Long> 0
    [sqlDateFormatString] => <String> 'YYYY-MM-DD'
)
)

Enumeratoren

Es gibt verscheidene öffentliche Enumeratoren.

dtParams

dtParams steuert das Verhalten der Klasse. Die verschiedenen Paramter sind komulierbar, wobei nicht alle Kombinationen Sinn ergeben

Public Enum dtParams
    dtNone = 0
    'Parameters zur Behandlung des InputStrings
    dtInFormatIgnoreCase = 2 ^ 0        'Gross-Kleinschreibung bei Trennzeichen ignorieren
    dtInFormatFormat2 = 2 ^ 1           'Beim Ãœbergabewert iFormat handelt sich um ein Format im Stil von {$DD}.{$MM}
    'Paramter zur SQL-Ausgabe
    dtOutSqlFormatUs = 2 ^ 5            'SQL Format US
    dtOutSqlFormatIso8601 = 2 ^ 6       'SQL Format EU (ISO8601)
    dtOutSqlFormatManual = 2 ^ 7        'Das Format wird vom User vorgegeben (muss über SqlDateFormatString oder über setParameter(dtpSqlDateFormatString, ...) gesetzt werden)
End Enum

dtSqlFormats

Paramter um das SQL-Format zu setzen. Es sind alle auch in dtParams vorhanden.

Public Enum dtSqlFormats
    dtsqlus = dtOutSqlFormatUs              'US: #MM/DD/YYYY#
    dtSqlIso8601 = dtOutSqlFormatIso8601    'EU, ISO-Norm: #YYYY-MM-DD#     https://de.wikipedia.org/wiki/ISO_8601
    dtSqlManual = dtOutSqlFormatManual      'User Spezialformat
    dtSqlDefault = dtsqlus                  'Standard definieren
End Enum

dtReturnTypes

Bei gewissen Methoden kann man das Rückgabetype auswählen

Public Enum dtReturnTypes
    dtDateTime = 2 ^ 15     'dtOutDateTime
    dtTimestamp = 2 ^ 16    'dtOutTimestamp
    dtRetDefault = dtDateTime
End Enum

dtErrorNumbers

Mögliche Errors. Normalerweise programmiere ich dazu Public Const. Das geht aber in eine Class nicht.

Public Enum dtErrorNumbers
    dtErrInvalidFormat = vbObjectError + 1      'Der String passt nicht mit dem Format überein
    dtErrNotParseble = vbObjectError + 2        'Das Format ist nicht parsbar
End Enum

dtProperties

Attribute, die gesetzt werden können. Wird für setProperty genutzt

Public Enum dtProperties
    dtpTimestamp
    dtpDateValue
    dtpTimeValue
    dtpYear
    dtpMonth
    dtpDay
    dtpHour
    dtpMinute
    dtpSecond
    dtpNanoSecond
    dtpMicroSecond
    dtpMilliSecond
    dtpFirstWeekOfYear
    dtpFirstDayOfWeek
    dtpPatternDelemiter
    dtpDayOfWeek
    dtpQuarter
    dtpWeek
    dtpDayOfYear
    dtpSqlTimeStamp
    dtpSqlDate
    dtpSqlTime
    dtpSqlFormat
    dtpReturnType
    dtpSqlDateFormatString
End Enum

Creatoren

Verschiedene Initialwerte für construct() und instance()

Hier die verschiedenen Arten, wie ein DateTime initialisert werden kann. Ich setze hier immer die Werte direkt ein. Natürlich funktioniert das auch alles aus Variablen hinaus.

Aktueller Timestamp

Die folgenden Beispiele initialisieren ein DateTime mit dem Aktuellen Timestamp

d DateTime().timestamp
<Date> 30.03.2016 15:10:51
 
d DateTime(now).timestamp
<Date> 30.03.2016 15:11:00
 
d DateTime(Null).timestamp
<Date> 30.03.2016 15:11:12
 
d DateTime("").timestamp
<Date> 30.03.2016 15:11:25

Fixer TimeStamp

Es können verschiedene Date oder Time übergeben werden. Natürlich auch aus Date-Variablen

d DateTime(#2016-03-15 12:00:00#).timestamp
<Date> 15.03.2016 12:00:00
 
d DateTime(#2016-03-15#).timestamp
<Date> 15.03.2016
 
d DateTime(#12:00:00#).timestamp
<Date> 12:00:00

Und dasselbe mit Datumsstring. Es funktionieren auch Formatiert Strings analog zu [VBA] strToDate()

d DateTime("2016-02-18").timestamp
<Date> 18.02.2016
 
d DateTime("20160218", "YYYYMMDD").timestamp
<Date> 18.02.2016
 
d DateTime("20160218", "{$YYYY}{$MM}{$DD}", dtInFormatFormat2).timestamp
<Date> 18.02.2016

Auch DateTime Objekte können übergeben werden.

d DateTime(DateTime()).timestamp
<Date> 30.03.2016 15:19:13

Interval als Startparameter

Auch ein [VBA] DateInterval kann übergeben werden. Entweder nur der IntervalString oder ein ganzes Objekt. Der Interval wird autumatisch zum aktuellen Timestamp hinzugerechnet. Also: Jetzt + Interval

d DateTime("P3D").dateValue
<Date> 02.04.2016

d DateTime(DateInterval("P3D")).dateValue
<Date> 02.04.2016

d DateTime("-P3D").dateValue
<Date> 27.03.2016

construct()

Set obj2 = obj1.construct([timestamp][, format[, FormatParams[, FirstDayOfWeek[, FirstWeekOfYear]]]])

Setzt die Werte in ein bestehndes DateTime Objekt und gibt eine Referenz auf sich selber zurück.

Für die Variante mit einem Datumsstring siehe auch [VBA] strToDate()
'/**
' * Initialisiert das Objekt
' * @param  Date/String/DateTime    Timestamp. Ein Datum, ein Datumsstring oder ein DateTime Objekt. Standart ist Now()
' * @param  String                  Wenn der TimeStampein String ist, kann hier das Format mitgegeben werden. Siehe auch http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/strtodate
' * @param  dtDtringParams          Weitere Parameters zum Stringformat
' * @param  vbDayOfWeek             Erster Tag der Woche
' * @param  vbFirstWeekOfYear       Definition der ersten Kalenderwoche im Kalender
' * @return DateTime
' */
Public Function construct( _
    Optional ByRef iTimestamp As Variant = Null, _
    Optional ByVal iFormat As String = Empty, _
    Optional ByVal iFormatParams As dtStringParams = dtStringNone, _
    Optional ByVal iFirstDayOfWeek As VbDayOfWeek = vbUseSystemDayOfWeek, _
    Optional ByVal iFirstWeekOfYear As VbFirstWeekOfYear = vbUseSystem _
) As DateTime
Beispiel
    Dim dt1 As New DateTime
    Dim dt2 As DateTime
 
    Set dt2 = dt1.construct(#1/1/2015#)     'dt1 auf den ersten Januar setzen und als Referenz auf dt2 verknüpfen
    Debug.Print dt1.timestamp               ' -> 01.01.2015
    Debug.Print dt2.timestamp               ' -> 01.01.2015
    dt2.construct "15072015", "DDMMYYYY"    'in der Referenz das Datum auf den 15.Juli setzen
                                            'anschlissend das referenzierte Objekt abfragen
    Debug.Print dt1.timestamp               ' -> 15.07.2015

instance()

Set obj = DateTime([timestamp][, format[, FormatParams[, FirstDayOfWeek[, FirstWeekOfYear]]]])

Instanciert ein DateTime Objekt. Da diese Methode das versteckte Attribut instance.VB_UserMemId gesetzt hat, ist es die Standartfunktion für die DateTime Instanzierung. Diese Methode eignet sich sehr gut, wenn man nur mal eben was rechnen muss, das Objekt aber nachher nicht mehr braucht.

Für die Variante mit einem Datumsstring siehe auch [VBA] strToDate()
'/**
' * Erstellt eine neue Insatance
' * Besitzt das Attribute instance.VB_UserMemId = 0. Darum ist dies die Standardfunktion für DateTime()
' * @param  Date/String/DateTime    Timestamp. Ein Datum, ein Datumsstring oder ein DateTime Objekt. Standart ist Now()
' * @param  String                  Wenn der TimeStampein String ist, kann hier das Format mitgegeben werden. Siehe auch http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/strtodate
' * @param  dtDtringParams          Weitere Parameters zum Stringformat
' * @param  vbDayOfWeek             Erster Tag der Woche
' * @param  vbFirstWeekOfYear       Definition der ersten Kalenderwoche im Kalender
' * @return DateTime
' */
Public Function instance( _
    Optional ByRef iTimestamp As Variant = Null, _
    Optional ByVal iFormat As String = Empty, _
    Optional ByVal iFormatParams As dtStringParams = dtStringNone, _
    Optional ByVal iFirstDayOfWeek As VbDayOfWeek = vbUseSystemDayOfWeek, _
    Optional ByVal iFirstWeekOfYear As VbFirstWeekOfYear = vbUseSystem _
) As DateTimee
Beispiele
'Einfache instanzierung eines Objektes
    Dim dt1 As Datim
    Set dt1 = DateTime(#1/1/2015#)
 
'Einfache Verwendung: Differenz in Tagen vom 1ten Januar bis heute
    Dim diffInDays As Long
    diffInDays = DateTime(#1/1/2015#).diff(Now).days
d DateTime(#1-1-2015#).timestamp
<Date> 01.01.2015
d DateTime("Der Timestamp ist: 02032015", "DDMMYYYY" ,dtStringExtractDate).timestamp
<Date> 02.03.2015

serial()

Set dt1 = DateTime.serial([Jahr [,Monat [,Tag [,Stunden [,Minuten [,Sekunden [,Nanosekunden [,Rückgabeart]]]]]]]])
'/**
' * Setzt Datum und Zeit. Entspricht DateSerial() + TimeSreial() + Nanosekunden
' * @param  ...                     Die einzelnen Teile
' * @param  Booelan                 Angabe ob der Rückgabewert eine neue Instanz oder eine Referenz sein soll
' * @param  vbDayOfWeek             Erster Tag der Woche
' * @param  vbFirstWeekOfYear       Definition der ersten Kalenderwoche im Kalender
' * @return DateTime
' */
Public Function serial( _
        Optional ByVal iYear As Variant = Null, _
        Optional ByVal iMonth As Integer = 1, _
        Optional ByVal iDay As Integer = 1, _
        Optional ByVal iHour As Integer = 0, _
        Optional ByVal iMinute As Integer = 0, _
        Optional ByVal iSecond As Integer = 0, _
        Optional ByVal iNanoSecond As Variant = 0, _
        Optional ByVal iByRef As Boolean = False, _
        Optional ByVal iFirstDayOfWeek As VbDayOfWeek = vbUseSystemDayOfWeek, _
        Optional ByVal iFirstWeekOfYear As VbFirstWeekOfYear = vbUseSystem _
) As DateTime
Beispiel
d DateTime.serial(2015, 1, 1, 12, 30, 0, 200015056)
<Class Module::DateTime>  (
    [timestamp] => <Date> 01.01.2015 12:30:00
    [dateValue] => <Date> 01.01.2015
    [timeValue] => <Date> 12:30:00
    [year] => <Integer> 2015
    [month] => <Integer> 1
    [day] => <Integer> 1
    [hour] => <Integer> 12
    [minute] => <Integer> 30
    [second] => <Integer> 0
    [nanoSecond] => <Long> 200015056
    [microSecond] => <Long> 200015
    [milliSecond] => <Long> 200
)

Methoden auf einer Instance

Allgemein: Rückgabeparamter iByRef (Rückgabewert)

Die meisten Methoden besitzen den Paramter iByRef (Boolean). Dieser sagt aus, ob das Objekt selber verändert und zurückgegeben wird oder ob das Resultat eine neue DateTime-Instanz ist

  • FALSE (Default)7): Der Rückgabewert ist ein Clone an dem die Veränderung vorgenommen wurde.
  • TRUE (Default): Das Objekt selber wird verändert und eine Referenz wird zurückgegeben.
Beispiel
    Dim dt1 As DateTime
    Dim dt2 As DateTime
 
    'Das Objekt selber verändern
    Set dt1 = DateTime(#6/1/2015#)
    dt1.add "P1M"
    print_r dt1.dateValue       '-> <Date> 01.07.2015
 
    'Die Veränderung nur als neues Objekt zurückgeben
    Set dt1 = DateTime(#6/1/2015#)
    Set dt2 = dt1.minus("P1M", False)
    print_r dt1.dateValue       '-> <Date> 01.06.2015
    print_r dt2.dateValue       '-> <Date> 01.05.2015
 
    'Das Objekt selber verändern und gleichzeitig eine Referenz zurückgeben
    Set dt1 = DateTime(#6/1/2015#)
    Set dt2 = dt1.minus("P1M")
    print_r dt1.dateValue       '-> <Date> 01.05.2015
    print_r dt2.dateValue       '-> <Date> 01.05.2015
    'Wenn dt2 ist eine Referenz auf dt1. Wenn wir jetzt dt2 ändern, ändert sich auch dt1
    dt2.add ("P2M")
    print_r dt1.dateValue       '-> <Date> 01.07.2015
    print_r dt2.dateValue       '-> <Date> 01.07.2015

Allgemein: Verkettung der Methoden

Die meisten Methoden geben wieder einen DateTime zurück. Normalerweise eine Referenz auf den bestehenden. Siehe dazu Allgemein: Rückgabeparamter iByRef (Rückgabewert). Dadurch kann man die Methoden miteinander Verketten. Da [VBA] DateInterval das auch anbietet, kann amn diese 2 dabei schön kombinieren.

Zum Beispiel: Erster Tag der aktuellen Woche + 4 Wochen und dazu die Differenz zu jetzt in Tagen

d DateTime().trunc("WW").add("P4W").diff().days
<Long> 26

'Jetzt. Dann den Monat auf den Juli überschreiben, den Tag auf den 3ten. Dann auf den Letzten Tag der Woche gehen und diesen Formatiert ausgeben

d DateTime().modify("M", 6).modify("D", 3).getLastDayOfWeek.format("D MMMM YYYY")
<String> '5 Juni 2016'

Und dasselbe. Jedoch eine Monat weniger, dafür mehr Tage als der Mai hat..

d DateTime().modify("M", 5).modify("D", 34).getLastDayOfWeek.format("D MMMM YYYY")
<String> '5 Juni 2016'

add()/minus()

Set dt2 = dt1.add(DateInterval [,Rückgabeart])
Set dt2 = dt1.minus(DateInterval [,Rückgabeart])

Rechnet ein Dateinterval zum Datum hinzu. Das Datumsintervall kann entwder vom Typ [VBA] DateInterval sein oder ein Dateinterval String (ISO8601 Duration Definition8)). Ebenso kann es eine Anzahl Tage sein. Will man eine andere Grösse einfach verändern, dann empfiehlt sich die Methode addSingleValue

'/**
' * Rechnet ein DateInterval zum Datum hinzu und gibt ein neues DateTime zurück.
' * @param  DateInterval/IntervalSpec/Days
' * @param  Boolean                             true: Das DateTimeObjekt wird selber nicht verändert - False: Das Objekt selber wird verändert
' * @return DateTime
' */
Public Function add( _
    ByRef iInterval As Variant, _
    Optional ByVal iByRef As Boolean = False _
) As DateTime
Beispiel
'1 Monat, 3 Tage und 12 Stunden zum 1ten Januar hinzuzählen
d DateTime(#1-1-2015#).add("P1M3DT12H").timestamp
<Date> 04.02.2015 12:00:00

addSingleValue()

Set dt2 = dt1.addSingleValue(interval, number [,Rückgabeart])

Im Gegensatz zu add/minus wird hier nur ein einzelner Wert verändert. So wie man es von dateAdd() im VB kennt.

'/**
' * Rechnet ein einzelnen Part hinzu
' * @param  String      Interval-String gem. DateAdd().  Y, M, D, H, N, S, F
' * @param  Variant     Wert
' * @param  Boolean                             true: Das DateTimeObjekt wird selber nicht verändert - False: Das Objekt selber wird verändert
' * @return DateTime
' */
Public Function addSingleValue( _
    ByVal iInterval As String, _
    ByVal iNumber As Variant, _
    Optional ByVal iByRef As Boolean = False _
) As DateTime
Beispiel
'2 Monate vom ersten Januar abziehen
d DateTime(#1-1-2015#).addSingleValue("M", -3).timestamp
<Date> 01.10.2014

clone()

Set dt2 = dt1.clone

Erstellt ein Klon eines DateTime Objektes. Wenn man den Klon verändert, ändert das nichts an dem Basisobjekt

'/**
' * Klont das Objekt
' * @return DateTime
' */
Public Function clone() As DateTime

diff()

Set di = dt.diff([timestamp, absolute]])

Erstellt ein [VBA] DateInterval aufgrunde einem weiteren Timestamp

'/**
' * Gibt die Differenz als DateInterval zu einem Datum zurück
' * @param  Date/String/DateTime
' * @param  Boolean
' * @return DateInterval
' */
Public Function diff( _
    Optional ByRef iTimestamp As Variant = Null, _
    Optional ByVal iAbsolute As Boolean = False _
) As DateInterval
    Set diff = DateInterval.instanceFromDateDiff(pTimeStamp, iTimestamp, iAbsolute)
End Function
Beispiel
'Differnez von heute bis ende letzes Jahr. Ausgabe nach ISO8601 Duration Definition
d DateTime(#12-31-2014#).diff(now).intervalSpec
<String> '-P7M19DT10H28M11S'
d DateTime(#12-31-2014#).diff(now, true).intervalSpec
<String> 'P7M19DT10H28M24S'

format()

 dateString = dt1.format(format [,FirstDayOfWeek [,FirstWeekOfYear]])

Wendet VBA.Format auf das DateTime Objekt an. Micro-/Milli-/Nanosekunden können mit F mitgegeben werden. Nanosekunden sind eigentlich 9 Stellen. Für die Ausgabe der Nanosekunden einfach 9 F schreiben, Für Milli 6 etc.

'/**
' * Gibt ein formatiertes Datum zurück -> VBA.format()
' * Pattern gemäss VBA-format plus Nanosekunden (F). Die Anzahl F gibt die Nachkommastellen der Sekunden an.
' * @param  String  Format
' * @param  vbDayOfWeek             Erster Tag der Woche
' * @param  vbFirstWeekOfYear       Definition der ersten Kalenderwoche im Kalender
' */
 
Public Function format( _
        ByVal iFormat As String, _
        Optional ByVal iFirstDayOfWeek As VbDayOfWeek = -1, _
        Optional ByVal iFirstWeekOfYear As VbFirstWeekOfYear = -1 _
) As String
Beispiel
d DateTime().format("DDDD, D. MMMM YYYY")
<String> 'Montag, 5. Oktober 2015'
 
'Nanosekunden
d DateTime("12:32:54.000001342").format("S.FFFFFFFFF")
<String> '54.000001342'
 
'Millisekunden
d DateTime("12:32:54.000000742").format("S.FFFFFF")
<String> '54.000001'

format2()

 dateString = dt1.format2(format [,FirstDayOfWeek [,FirstWeekOfYear]])

Formatiert ein DateTime zu einem String. Im Gegensatz zu format() werden die Formate als Pattern mitgegeben. Dadurch lassen sich Texte einfach parsen. Jedes Pattern, das formatiert werden soll muss in {$..} geschrieben werden. Siehe dazu die Beispiele.

'/**
' * Gibt ein formatiertes Datum zurück. Im gegensatz zu format() müssend ie Pattern in {$...} geschtrieben werden
' * @param  String  Format
' * @param  vbDayOfWeek             Erster Tag der Woche
' * @param  vbFirstWeekOfYear       Definition der ersten Kalenderwoche im Kalender
' */
Public Function format2( _
        ByVal iFormat As String, _
        Optional ByVal iFirstDayOfWeek As VbDayOfWeek = -1, _
        Optional ByVal iFirstWeekOfYear As VbFirstWeekOfYear = -1 _
) As String
Beispiel
d DateTime().format2("Heute ist der {$dd.mm.yyyy}")
<String> 'Heute ist der 05.01.2016'
 
d DateTime().format2("Heute ist der {$y} in der {$w} des Jahres {$yyyy}")
<String> 'Heute ist der 5 in der 2 des Jahres 2016'
 
d DateTime("00:02:45.003754").format2("{$n} Minuten, {$s} Sekunden und {$fff} Milisekunden")
<String> '2 Minuten, 45 Sekunden und 004 Milisekunden'
 
d DateTime(#13-05-2016#).format2("Heute ist der {$dd.mm.yyyy}. Es ist der {$w}te Tag in der {$ww}ten Kalenderwoche")
<String> 'Heute ist der 13.05.2016. Es ist der 5te Tag in der 19ten Kalenderwoche'

trunc()

Set dt2 = dt1.trunc([interval [,Rückgabeart]])

Kürzt ein DateTime auf einen bestimmten Teil. So ähnlich wie der int() Befehl

'/**
' * Schneidet Den Hinteren Teil des Timestamps ab
' * @example    DateTime(#2014-04-05 13:34:14#).trunc("H")  --> 05.04.2014 13:00:00
'               DateTime(#2014-04-05 13:34:14#).trunc("M")  --> 01.04.2014 00:00:00
' * @param  String      Interval-String gem. DateAdd().  YYYY, M, D, H, N, S
' * @param  Boolean     true: Das DateTimeObjekt wird selber nicht verändert - False: Das Objekt selber wird verändert
' * @return DateTime
' */
Public Function trunc( _
        Optional ByVal iInterval As String = "D", _
        Optional ByVal iByRef As Boolean = False _
) As DateTime
Beispiel
'Standartmässig wird auf den Tag gekürzt
d DateTime(#8-19-2015 12:30:54#).trunc().timestamp
<Date> 19.08.2015
 
'Auf die Stunde kürzen
d DateTime(#8-19-2015 12:30:54#).trunc("H").timestamp
<Date> 19.08.2015 12:00:00
 
'und auf den Monat
d DateTime(#8-19-2015 12:30:54#).trunc("M").timestamp
<Date> 01.08.2015

round()

Set dt2 = dt1.round([interval [,Rückgabeart]])

Rundet den Timestamp auf die entsprechende Grösse. Analog zu runc().

'/**
' * Rundet den Timestamp
' * @example    DateTime(#2014-04-05 13:15:56#).round("H")  --> 05.04.2014 13:00:00
'               DateTime(#2014-04-05 13:34:14#).round("H")  --> 05.04.2014 14:00:00
' * @param  String      Interval-String gem. DateAdd().  YYYY, M, D, H, N, S
' * @param  Boolean     true: Das DateTimeObjekt wird selber verändert - False: Das Objekt selber wird nicht verändert
' * @return DateTime
' */
Public Function round( _
        Optional ByVal iInterval As String = "D", _
        Optional ByVal iByRef As Boolean = C_DEFAULT_BYREF _
) As DateTime
Beispiel
d DateTime(#2016-03-18#).round("M").dateValue
<Date> 01.04.2016
 
d DateTime(#2016-03-14#).round("M").dateValue
<Date> 01.03.2016
 
'Erster Tag der Woche
d DateTime(#2016-03-18#).round("W").dateValue
<Date> 21.03.2016

interval()

myArray = dt1.interval(DateInterval, Grösse oder Enddatum [,Rückgabeart])

Diese Methode erstellt ein Array mit einer ganzen Datumserie in DateInterval abständen.

'/**
' * Erstellt ein Array mit einem Interval. Als erstes Datum wird der aktuelle DateTime verwendet
' * @param  DateInterval/IntervalSpec/Days
' * @param  Long/DateTime/Timestamp         Anzahl Einträge oder ein Endzeitpunkt
' * @param  dtReturnTypes                   Rückgabeformat: timestamp oder DateTime
' * @return Array<timestamp/DateTime>
' */
Public Function interval(ByRef iIntervalSpec As Variant, ByRef iSizeOrEnd As Variant, Optional ByVal iReturnType As dtReturnTypes = dtTimestamp) As Variant()
Beispiel
'3er Interval ab dem 18 März 2016. Rückgabewert ist Standartmässig als VBA.Date
d DateTime(#2016-03-18#).interval("P2D", 3)
<Variant()>  (
    [0] => <Date> 18.03.2016
    [1] => <Date> 20.03.2016
    [2] => <Date> 22.03.2016
)
 
'1 Woche + 1 Tag + 12 Stunden. Zudem ist das Ende über ein Datum definiert
d DateTime(#2016-03-18 12:00:00#).interval("P1W1DT12H", #2016-04-10#)
<Variant()>  (
    [0] => <Date> 18.03.2016 12:00:00
    [1] => <Date> 27.03.2016
    [2] => <Date> 04.04.2016 12:00:00
)
 
'Und mit DateTime als Rückgabewert
d DateTime(#2016-01-18 12:00:00#).interval(DateInterval.serial(,1), DateTime(), dtDateTime)
<Variant()>  (
    [0] => <Class Module::DateTime>  (
        [timestamp] => <Date> 18.01.2016 12:00:00
        [dateValue] => <Date> 18.01.2016
        [timeValue] => <Date> 12:00:00
        ...
    )
    [1] => <Class Module::DateTime>  (
        [timestamp] => <Date> 18.02.2016 12:00:00
        [dateValue] => <Date> 18.02.2016
        [timeValue] => <Date> 12:00:00
        ...
    )
    [2] => <Class Module::DateTime>  (
        [timestamp] => <Date> 18.03.2016 12:00:00
        [dateValue] => <Date> 18.03.2016
        [timeValue] => <Date> 12:00:00
        ...
    )
)

modify()

Set dt2 = dt1.modify(interval, Neuwert [,Rückgabeart])

Entspricht dem Setzen eines Attributes. Guibt jedoch ein DateTime zurück und kann darum direkt weiterverwendet werden

'/**
' * Ersetzt einen einzelnen Teil des Datums und gibt ein DateTime zurück
' * @param  String      Interval-String gem. DateAdd().  YYYY, M, D, H, N, S, F, Y, WW, W
' * @param  Long     Neuer Wert
' * @param  Boolean     true: Das DateTimeObjekt wird selber nicht verändert - False: Das Objekt selber wird verändert
' * @return DateTime
' */
Public Function modify( _
    ByVal iInterval As String, _
    ByVal iNumber As Long, _
    Optional ByVal iByRef As Boolean = False _
) As DateTime
Beispiel
'Einfache Anwendung: Setze den Tag eines Jahres und ändere danach das Jahr
d DateTime("2015211", "YYYY@Y").modify("YYYY", 2014).timestamp
<Date> 30.07.2014
 
'Fortlaufende anwendung. Im Unterschied zu den Attributen kann hier gleich weitergerechnet werden
'Dito zu oben, aber ermittle die Differenz zu heute
d DateTime("2015211", "YYYY@Y").modify("YYYY", 2014).diff(DateTime().trunc("D")).intervalSpec
<String> '-P1Y25D'

setProperty()

Mit dieser Methode kann ein Property angepast werden und das Resultat gleich weiterverarbeiten werden.

'/**
' * Setzt ein Property ung gibt ein DateTime zurück
' * @param  dtProperties    Info, welches Property gesetzt werden soll
' * @param  Variant         Wert
' * @param  Boolean         true: Das DateTimeObjekt wird selber verändert - False: Das Objekt selber wird nicht verändert
' * @return DateTime
' */
Public Function setProperty( _
        ByVal iProperty As dtProperties, _
        ByVal iValue As Variant, _
        Optional ByVal iByRef As Boolean = C_DEFAULT_BYREF _
) As DateTime
Beispiele
? DateTime().setProperty(dtpDay,1).sqlDate
#06/01/2016#
 
? DateTime().setProperty(dtpSqlFormat, dtSqlFormats.dtSqlIso8601).sqlDate
#2016-06-27#
 
? DateTime().setProperty(dtpSqlFormat, dtSqlFormats.dtSqlIso8601).setProperty(dtpDay,1).sqlDate
#2016-06-01#

toString()

Gibt den Timestampals String zurück. Das Format kann mitgegen werden. Ansonsten wird das mit dem Format sqlTimeStamp formatiert.

'/**
' * Gibt ein String-Wert eines Objektes zurück
' * @return String
' */
Public Property Get toString(Optional ByVal format As String) As String
Beispiele
?DateTime().toString()
#07/04/2016 10:43:24#
 
?DateTime().toString("DD\.MM\.YYYY")
04.07.2016

Code

datetime.cls
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "DateTime"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-------------------------------------------------------------------------------
'File         : DateTime.cls
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/
'Environment  : VBA 2007+
'Version      : 1.10.0
'Name         : DetTime
'Author       : Stefan Erb (ERS)
'History      : 06.08.2014 - ERS - Creation
'               ...
'               29.03.2016 - ERS - sqlTimestamp/sqlDate und sqlTime Properties hinzugefügt. iByRef Standart in die Konstante C_DEFAULT_BYREF ausgelagert
'               21.06.2016 - ERS - Add Interface IFormattable
'               28.06.2016 - ERS - Kleine Fehler beim SQL-Formatumstellung behoben
'               04.07.2016 - ERS - Interfcae IFormattable und toString() um Parameters erweitert
'-------------------------------------------------------------------------------
Option Explicit
 
'-------------------------------------------------------------------------------
' -- ! SETTINGS !
'-------------------------------------------------------------------------------
'In Excel funktionieren Events nicht. Auch der NZ() gibt es dort nicht.
'Darum hier angeben ob es sich um MS Access handelt oder eben nicht. Leider gibts datzu keine Systemvariable
#Const isAccess = True
 
'Das Interface IFormattable ist in diesem Projekt vorhanden
#Const IFormattable_exists = True
 
'-------------------------------------------------------------------------------
' -- Interfaces
'-------------------------------------------------------------------------------
'/**
' * Das Interface IFormattable
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/classes/iformattable
' */
#If IFormattable_exists Then
    Implements IFormattable
#End If
 
'-------------------------------------------------------------------------------
' -- Public Members
'-------------------------------------------------------------------------------
 
'/**
' * Zusätzliche Parameters zu strToDate
' */
Public Enum dtParams
    dtNone = 0
    'Parameters zur Behandlung des InputStrings
    'dtInFormatIgnoreCase = 2 ^ 0        'Gross-Kleinschreibung bei Trennzeichen ignorieren
    dtInFormatFormat2 = 2 ^ 1           'Beim Übergabewert iFormat handelt sich um ein Format im Stil von {$DD}.{$MM}
    'Paramter zur SQL-Ausgabe
    dtOutSqlFormatUs = 2 ^ 5            'SQL Format US
    dtOutSqlFormatIso8601 = 2 ^ 6       'SQL Format EU (ISO8601)
    dtOutSqlFormatManual = 2 ^ 7        'Das Format wird vom User vorgegeben (muss über SqlDateFormatString oder über setParameter(dtpSqlDateFormatString, ...) gesetzt werden)
    'Rückgabetype (ist noch nicht durchgehend umgesetzt!)
'    dtOutDateTime = 2 ^ 15               'Als Returntyp ein DateTime
'    dtOutTimestamp = 2 ^ 16              'Ein Timestamp
End Enum
 
'/**
' * Paramter um das SQL-Format zu setzen. Es sind alle auch in dtParams vorhanden.
' */
Public Enum dtSqlFormats
    dtsqlus = dtOutSqlFormatUs              'US: #MM/DD/YYYY#
    dtSqlIso8601 = dtOutSqlFormatIso8601    'EU, ISO-Norm: #YYYY-MM-DD#     https://de.wikipedia.org/wiki/ISO_8601
    dtSqlManual = dtOutSqlFormatManual      'User Spezialformat
    dtSqlDefault = dtsqlus                  'Standard definieren
End Enum
 
'/**
' * Bei gewissen Methoden kann man das Rückgabetype auswählen
' */
Public Enum dtReturnTypes
    dtDateTime = 2 ^ 15     'dtOutDateTime
    dtTimestamp = 2 ^ 16    'dtOutTimestamp
    dtRetDefault = dtDateTime
End Enum
 
'/**
' * mögliche Errors. Normalerweise programmiere ich dazu Public Const. Das geht aber in eine Class nicht.
' */
Public Enum dtErrorNumbers
    dtErrInvalidFormat = vbObjectError + 1      'Der String passt nicht mit dem Format überein
    dtErrNotParseble = vbObjectError + 2        'Das Format ist nicht parsbar
End Enum
 
'/**
' * Attribute, die gesetzt werden können. Wird für setProperty genutzt
' */
Public Enum dtProperties
    dtpTimestamp
    dtpDateValue
    dtpTimeValue
    dtpYear
    dtpMonth
    dtpDay
    dtpHour
    dtpMinute
    dtpSecond
    dtpNanoSecond
    dtpMicroSecond
    dtpMilliSecond
    dtpFirstWeekOfYear
    dtpFirstDayOfWeek
    dtpPatternDelemiter
    dtpDayOfWeek
    dtpQuarter
    dtpWeek
    dtpDayOfYear
    dtpSqlTimeStamp
    dtpSqlDate
    dtpSqlTime
    dtpSqlFormat
    dtpReturnType
    dtpSqlDateFormatString
    dtpSqlDateTimeFormatString
    dtpSqlTimeFormatString
End Enum
'-------------------------------------------------------------------------------
' -- Private Members
'-------------------------------------------------------------------------------
Private Const C_DEFAULT_PATTERN_DELEMITER = "@"         'Fakultatives Patterntrennzeichen für strToDate
 
Private Const C_DEFAULT_BYREF As Boolean = True         'Einstellung, ob standardmässig dieRückgabeobjekte eine Refernez zum Original sind oder ein Clone
 
Private Const C_SQL_DATE_US_FORMAT = "\#MM\/DD\/YYYY\#"     'US Datumsformat
Private Const C_SQL_DATE_ISO8601_FORMAT = "\#YYYY-MM-DD\#"  'Europa ISO8601 Format
 
Private Const C_SQL_DATETIME_US_FORMAT = "\#MM\/DD\/YYYY HH:NN:SS\#"
Private Const C_SQL_DATETIME_ISO8601_FORMAT = "\#YYYY-MM-DD HH:NN:SS\#"
 
Private Const C_SQL_TIME_US_FORMAT = "\#HH:NN:SS\#"
Private Const C_SQL_TIME_ISO8601_FORMAT = "\#HH:NN:SS\#"
 
Private pTimeStamp                  As Date                 'Der allumfassende Timestamp
Private pNanoSecond                 As Variant              'Die Nachkommastellen in Nanosekunden
Private pFirstDayOfWeek             As VbDayOfWeek          'Erster Wochentag der Woche
Private pFirstWeekOfYear            As VbFirstWeekOfYear    'Definition der ersten Kalenderwoche
Private pPatternDelemiter           As String               'Delemiter bei unklaren Formaten beim einlesen
Private pSqlFormat                  As dtSqlFormats         'SQL-Format
Private pReturnTypes                As dtReturnTypes        'Rückgabeart
Private pSqlDateFormatString        As String
Private pSqlDateTimeFormatString    As String
Private pSqlTimeFormatString        As String
Private pParams                     As dtParams
 
'/**
' * Wird in der Funktion strToDate() verwendet um die einzelnen Abschnitte zuzuordnen
' */
Private Enum enuDatePartType
    dptYear = 2 ^ 0
    dptMonth = 2 ^ 1
    dptDay = 2 ^ 2
    dptHour = 2 ^ 3
    dptMinute = 2 ^ 4
    dptSecound = 2 ^ 5
    dptAmPm = 2 ^ 6
    dptNanosecond = 2 ^ 7
End Enum
 
'/**
' * Verschiedene Parser (analog zu strToDate())
' */
Private Enum tdParser
    pcDay = 2 ^ 0
    pcMonth = 2 ^ 2
    pcYear = 2 ^ 3
    pcHour = 2 ^ 4
    pcMinute = 2 ^ 5
    pcSecound = 2 ^ 6
    pcAmPm = 2 ^ 7
    pcDayOfYear = 2 ^ 8
    pcDayOfWeek = 2 ^ 9
    pcWeekOfYear = 2 ^ 10
    pcNonosecound = 2 ^ 11
    pcQuarterEnd = 2 ^ 12
    pcQuarter = 2 ^ 13
    pcDate = pcDay + pcMonth + pcYear + pcDayOfYear + pcDayOfWeek + pcWeekOfYear + pcQuarter + pcQuarterEnd
    pcTime = pcHour + pcMinute + pcSecound + pcAmPm + pcNonosecound
End Enum
 
'-------------------------------------------------------------------------------
' -- Public Constructors
'-------------------------------------------------------------------------------
 
'/**
' * Erstellt eine neue Insatance
' * Besitzt das Attribute instance.VB_UserMemId = 0. Darum ist dies die Standardfunktion für DateTime()
' * @param  Date/String/DateTime    Timestamp. Ein Datum, ein Datumsstring oder ein DateTime Objekt. Standart ist Now()
' * @param  String                  Wenn der TimeStampein String ist, kann hier das Format mitgegeben werden. Siehe auch http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/strtodate
' * @param  dtDtringParams          Weitere Parameters zum Stringformat
' * @param  vbDayOfWeek             Erster Tag der Woche
' * @param  vbFirstWeekOfYear       Definition der ersten Kalenderwoche im Kalender
' * @return DateTime
' */
Public Function instance( _
    Optional ByRef iTimestamp As Variant = Null, _
    Optional ByVal iFormat As String = Empty, _
    Optional ByVal iparams As dtParams = dtNone, _
    Optional ByVal iFirstDayOfWeek As VbDayOfWeek = vbUseSystemDayOfWeek, _
    Optional ByVal iFirstWeekOfYear As VbFirstWeekOfYear = vbUseSystem _
) As DateTime
Attribute instance.VB_UserMemId = 0
'Attribute instance.VB_UserMemId = 0
 
    Set instance = New DateTime: instance.construct iTimestamp, iFormat, iparams, iFirstDayOfWeek, iFirstWeekOfYear
End Function
 
'/**
' * Initialisiert das Objekt
' * @param  Date/String/DateTime    Timestamp. Ein Datum, ein Datumsstring oder ein DateTime Objekt, ein DateInterval oder ein DateInterval String. Standart ist Now()
' * @param  String                  Wenn der TimeStamp ein String ist, kann hier das Format mitgegeben werden. Siehe auch http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/strtodate
' * @param  dtDtringParams          Weitere Parameters zum Stringformat
' * @param  vbDayOfWeek             Erster Tag der Woche
' * @param  vbFirstWeekOfYear       Definition der ersten Kalenderwoche im Kalender
' * @return DateTime
' */
Public Function construct( _
    Optional ByRef iTimestamp As Variant = Null, _
    Optional ByVal iFormat As String = Empty, _
    Optional ByVal iparams As dtParams = dtNone, _
    Optional ByVal iFirstDayOfWeek As VbDayOfWeek = vbUseSystemDayOfWeek, _
    Optional ByVal iFirstWeekOfYear As VbFirstWeekOfYear = vbUseSystem _
) As DateTime
    'Paramters übernehmen
    pParams = iparams
    sqlFormat = iparams
    returnType = iparams
    firstDayOfWeek = iFirstDayOfWeek
    firstWeekOfYear = iFirstWeekOfYear
    'iTimestamp parsen
    Dim fd As Date: Select Case TypeName(iTimestamp)
        Case "DateTime":        pTimeStamp = iTimestamp.timestamp
        Case "DateInterval":    pTimeStamp = iTimestamp.addTo().timestamp
        Case "Date":            pTimeStamp = iTimestamp
        Case "String":
            'Ein In-Format ist definiert -> strToDate
            If iFormat <> Empty Then
                pTimeStamp = strToDate(CStr(iTimestamp), iFormat, iparams, iFirstDayOfWeek, iFirstWeekOfYear, pNanoSecond)
            'Es handelt sich um ein IntervalSpec
            ElseIf DateInterval.testIntervalString(CStr(iTimestamp)) Then
                pTimeStamp = DateInterval(iTimestamp).addTo().timestamp
            'Ein Datumsformatstring mit # begrenzt
            ElseIf iTimestamp Like "[#]*[#]" Then
                pTimeStamp = Eval(iTimestamp)
            Else
                'Die Nanosekunden extrahieren
                If rxExtractNanoSec.test(iTimestamp) Then
                    With rxExtractNanoSec.execute(iTimestamp)(0).subMatches
                        iTimestamp = .item(0)                   'Das Datum extrahieren
                        pNanoSecond = 10 ^ 9 * CDbl(.item(1))   'NanoSec bestimmen
                    End With
                End If
                'Timestamp parsen
                pTimeStamp = VBA.dateValue(iTimestamp) + VBA.timeValue(iTimestamp)
            End If
        Case "Null":        pTimeStamp = Now
        Case Else:
            'Die Numerischen Werte habe ich extra hier, ansonsten müsste ich alle Numerischen Tpen aufzählen
            If IsNumeric(iTimestamp) Then
                pTimeStamp = CDate(iTimestamp)
            Else
                Err.Raise 13, "DateTime.construct"
            End If
    End Select
    Set construct = Me
End Function
 
'/**
' * Setzt Datum und Zeit. Entspricht DateSerial() + TimeSreial() + Nanosekunden
' * @param  ...                     Die einzelnen Teile
' * @param  Booelan                 Angabe ob der Rückgabewert eine neue Instanz oder eine Referenz sein soll
' * @param  vbDayOfWeek             Erster Tag der Woche
' * @param  vbFirstWeekOfYear       Definition der ersten Kalenderwoche im Kalender
' * @return DateTime
' */
Public Function serial( _
        Optional ByVal iYear As Variant = Null, _
        Optional ByVal iMonth As Integer = 1, _
        Optional ByVal iDay As Integer = 1, _
        Optional ByVal iHour As Integer = 0, _
        Optional ByVal iMinute As Integer = 0, _
        Optional ByVal iSecond As Integer = 0, _
        Optional ByVal iNanoSecond As Variant = 0, _
        Optional ByVal iByRef As Boolean = C_DEFAULT_BYREF, _
        Optional ByVal iFirstDayOfWeek As VbDayOfWeek = vbUseSystemDayOfWeek, _
        Optional ByVal iFirstWeekOfYear As VbFirstWeekOfYear = vbUseSystem _
) As DateTime
    pFirstDayOfWeek = iFirstDayOfWeek
    pFirstWeekOfYear = iFirstWeekOfYear
    Dim ts As Date: ts = Empty
    If Not IsNull(iYear) Then ts = DateSerial(iYear, iMonth, iDay)
    If iHour + iMinute + iSecond > 0 Then ts = ts + TimeSerial(iHour, iMinute, iSecond)
 
    Set serial = retDt(ts, iNanoSecond, iByRef)
End Function
 
'-------------------------------------------------------------------------------
' -- Public Methodes
'-------------------------------------------------------------------------------
 
'/**
' * Klont das Objekt
' * @return DateTime
' */
Public Function clone() As DateTime
    Set clone = retDt(timestamp, nanoSecond, False)
End Function
 
'/**
' * Rechnet ein DateInterval zum Datum hinzu und gibt ein neues DateTime zurück.
' * @param  DateInterval/IntervalSpec/Days
' * @param  Boolean                             true: Das DateTimeObjekt wird selber verändert - False: Das Objekt selber wird nicht verändert
' * @return DateTime
' */
Public Function add(ByRef iInterval As Variant, Optional ByVal iByRef As Boolean = C_DEFAULT_BYREF) As DateTime
    Set add = addInterval(iInterval, 1, iByRef)
End Function
 
'/**
' * Rechnet ein einzelnen Part hinzu
' * @param  String      Interval-String gem. DateAdd().  Y, M, D, H, N, S, F, Q, W, WW
' * @param  Variant     Wert
' * @param  Boolean                             true: Das DateTimeObjekt wird selber verändert - False: Das Objekt selber wird nicht verändert
' * @return DateTime
' */
Public Function addSingleValue(ByVal iInterval As String, ByVal iNumber As Variant, Optional ByVal iByRef As Boolean = C_DEFAULT_BYREF) As DateTime
    Select Case UCase(iInterval)
        Case "Y", "M", "D", "H", "N", "S", "W", "WW", "Q":
            Set addSingleValue = retDt(DateAdd(iInterval, iNumber, pTimeStamp), 0, iByRef)
        Case "F":
            Dim nano As Variant: nano = pNanoSecond + iNumber
            Dim diffSec As Variant
            If nano > 999999999 Then
                diffSec = Fix(nano / 10 ^ 9)
                nano = nano - diffSec * 10 ^ 9
            ElseIf nano < 0 Then
                diffSec = Fix(nano / 10 ^ 9) - 1
                nano = Abs(diffSec * 10 ^ 9 - nano)
            End If
            Set addSingleValue = retDt(DateAdd("S", diffSec, pTimeStamp), nano, iByRef)
    End Select
End Function
 
'/**
' * Zählt ein DateInterval vom Datum ab und gibt ein neues DateTime zurück.
' * @param  DateInterval/IntervalSpec/Days
' * @param  Boolean                             true: Das DateTimeObjekt wird selber nicht verändert - False: Das Objekt selber wird verändert
' * @return DateTime
' */
Public Function minus(ByRef iInterval As Variant, Optional ByVal iByRef As Boolean = C_DEFAULT_BYREF) As DateTime
    Set minus = addInterval(iInterval, -1, iByRef)
End Function
'/**
' * Gibt die Differenz als DateInterval zu einem Datum zurück
' * @param  Date/String/DateTime
' * @param  Boolean
' * @return DateInterval
' */
Public Function diff( _
    Optional ByRef iTimestamp As Variant = Null, _
    Optional ByVal iAbsolute As Boolean = False _
) As DateInterval
    Set diff = DateInterval.instanceFromDateDiff(Me, iTimestamp, iAbsolute)
End Function
 
'/**
' * Gibt ein formatiertes Datum zurück -> VBA.format()
' * Pattern gemäss VBA-format plus Nanosekunden (F). Die Anzahl F gibt die Nachkommastellen der Sekunden an.
' * @param  String  Format
' * @param  vbDayOfWeek             Erster Tag der Woche
' * @param  vbFirstWeekOfYear       Definition der ersten Kalenderwoche im Kalender
' */
Public Function format( _
        ByVal iFormat As String, _
        Optional ByVal iFirstDayOfWeek As VbDayOfWeek = -1, _
        Optional ByVal iFirstWeekOfYear As VbFirstWeekOfYear = -1 _
) As String
    Dim firstDayOfWeek As VbDayOfWeek:          firstDayOfWeek = IIf(iFirstDayOfWeek = -1, pFirstDayOfWeek, iFirstDayOfWeek)
    Dim firstWeekOfYear As VbFirstWeekOfYear:   firstWeekOfYear = IIf(iFirstWeekOfYear = -1, pFirstWeekOfYear, iFirstWeekOfYear)
    Dim ns  As Double:                          ns = pNanoSecond / 10 ^ 9
    Dim correctedTimeStamp As Date:             correctedTimeStamp = pTimeStamp
    Dim pattern As String:                      pattern = iFormat
 
    If rxNS.test(pattern) Then
        Dim m As Object: For Each m In rxNS.execute(pattern)
            pattern = substrReplace(pattern, VBA.format(10 ^ m.length * ns, String(m.length, "0")), m.firstIndex, m.length)
        Next m
    ElseIf CInt(ns) = 1 Then
        'Microsekunden vorhanden, MS nicht im Format und grösser als 0.5 Sekunden -> Sekunden aufrunden
        correctedTimeStamp = DateAdd("S", 1, correctedTimeStamp)
    End If
    format = VBA.format(correctedTimeStamp, pattern, firstDayOfWeek, firstWeekOfYear)
End Function
 
'/**
' * Gibt ein formatiertes Datum zurück. Im gegensatz zu format() müssend ie Pattern in {$...} geschtrieben werden
' * @param  String  Format
' * @param  vbDayOfWeek             Erster Tag der Woche
' * @param  vbFirstWeekOfYear       Definition der ersten Kalenderwoche im Kalender
' */
Public Function format2( _
        ByVal iFormat As String, _
        Optional ByVal iFirstDayOfWeek As VbDayOfWeek = -1, _
        Optional ByVal iFirstWeekOfYear As VbFirstWeekOfYear = -1 _
) As String
    Dim firstDayOfWeek As VbDayOfWeek:          firstDayOfWeek = IIf(iFirstDayOfWeek = -1, pFirstDayOfWeek, iFirstDayOfWeek)
    Dim firstWeekOfYear As VbFirstWeekOfYear:   firstWeekOfYear = IIf(iFirstWeekOfYear = -1, pFirstWeekOfYear, iFirstWeekOfYear)
    Dim correctedTimeStamp As Date:             correctedTimeStamp = pTimeStamp
    Dim pattern As String
    Dim ns  As Double:                          ns = pNanoSecond / 10 ^ 9
 
    format2 = iFormat
 
    If CInt(ns) = 1 And Not rxNS2.test(format2) Then
        'Microsekunden vorhanden, MS nicht im Format und grösser als 0.5 Sekunden -> Sekunden aufrunden
        correctedTimeStamp = DateAdd("S", 1, correctedTimeStamp)
    End If
 
    'Microsekunden ausgeben
    Do While rxNS2.test(format2)
        Dim sm As Object: Set sm = rxNS2.execute(format2)(0).subMatches
        pattern = VBA.format(10 ^ Len(sm(2)) * ns, String(Len(sm(2)), "0"))
        If Len(sm(1)) + Len(sm(4)) > 0 Then pattern = sm(0) & pattern & sm(3)
        format2 = rxNS2.Replace(format2, pattern)
    Loop
 
    Do While rxFormats2.test(format2)
        pattern = rxFormats2.execute(format2)(0).subMatches(0)
        format2 = rxFormats2.Replace(format2, VBA.format(correctedTimeStamp, pattern, firstDayOfWeek, firstWeekOfYear))
    Loop
End Function
 
'/**
' * Schneidet Den Hinteren Teil des Timestamps ab
' * @example    DateTime(#2014-04-05 13:34:14#).trunc("H")  --> 05.04.2014 13:00:00
'               DateTime(#2014-04-05 13:34:14#).trunc("M")  --> 01.04.2014 00:00:00
' * @param  String      Interval-String gem. DateAdd().  YYYY, M, D, H, N, S
' * @param  Boolean     true: Das DateTimeObjekt wird selber verändert - False: Das Objekt selber wird nicht verändert
' * @return DateTime
' */
Public Function trunc( _
        Optional ByVal iInterval As String = "D", _
        Optional ByVal iByRef As Boolean = C_DEFAULT_BYREF _
) As DateTime
    Set trunc = retDt(truncTimestamp(iInterval), 0, iByRef)
End Function
 
'/**
' * Rundet den Timestamp
' * @example    DateTime(#2014-04-05 13:15:56#).round("H")  --> 05.04.2014 13:00:00
'               DateTime(#2014-04-05 13:34:14#).round("H")  --> 05.04.2014 14:00:00
' * @param  String      Interval-String gem. DateAdd().  YYYY, M, D, H, N, S
' * @param  Boolean     true: Das DateTimeObjekt wird selber verändert - False: Das Objekt selber wird nicht verändert
' * @return DateTime
' */
Public Function round( _
        Optional ByVal iInterval As String = "D", _
        Optional ByVal iByRef As Boolean = C_DEFAULT_BYREF _
) As DateTime
    Dim ts As Date: ts = timestamp
    Dim delta As Integer
    Select Case UCase(iInterval)
        Case "YYYY", "YY", "Y": delta = CInt(VBA.month(ts) / 12)
        Case "M", "MM":         delta = CInt(VBA.day(ts) / VBA.day(DateSerial(VBA.year(ts), VBA.month(ts) + 1, 0)))
        Case "D", "DD":         delta = CInt(VBA.hour(ts) / 24)
        Case "H", "HH":         delta = CInt(VBA.minute(ts) / 60)
        Case "N", "NN":         delta = CInt(VBA.second(ts) / 60)
        Case "S", "SS":         delta = CInt(pNanoSecond / 10 ^ 9)
        Case "W", "WW":         delta = CInt(VBA.format(ts, "w", pFirstDayOfWeek) / 7)
        Case Else:      Err.Raise 13, "DateTime.round"
    End Select
    Set round = retDt(truncTimestamp(iInterval, delta), 0, iByRef)
End Function
 
'/**
' * Erstellt ein Array mit einem Interval. Als erstes Datum wird der aktuelle DateTime verwendet
' * @param  DateInterval/IntervalSpec/Days
' * @param  Long/DateTime/Timestamp         Anzahl Einträge oder ein Endzeitpunkt
' * @param  dtReturnTypes                   Rückgabeformat: timestamp oder DateTime
' * @return Array<timestamp/DateTime>
' */
Public Function interval(ByRef iIntervalSpec As Variant, ByRef iSizeOrEnd As Variant, Optional ByVal iReturnType As dtReturnTypes = dtTimestamp) As Variant()
    Dim di As DateInterval:     Set di = DateInterval(iIntervalSpec)
    Dim argIsSize As Boolean:   argIsSize = IsNumeric(iSizeOrEnd)
    Dim dt As DateTime:         Set dt = Me.clone
    Dim endTs As Date:          If Not argIsSize Then endTs = DateTime(iSizeOrEnd).timestamp
    Dim size As Long:           If argIsSize Then size = CLng(iSizeOrEnd)
    Dim retArr() As Variant
    Dim i As Long
    Do While IIf(argIsSize, i < size, dt.timestamp <= endTs)
        ReDim Preserve retArr(i)
        'Datum in Array übernehmen
        refDt retArr(i), iReturnType, dt, False
        i = i + 1
        'Datum vorrücken
        dt.add di, True
    Loop
    interval = retArr
End Function
 
'/**
' * Ersetzt einen einzelnen Teil des Datums und gibt ein DateTime zurück
' * @param  String      Interval-String gem. DateAdd().  YYYY, M, D, H, N, S, F
' * @param  Long        Neuer Wert
' * @param  Boolean     true: Das DateTimeObjekt wird selber verändert - False: Das Objekt selber wird nicht verändert
' * @return DateTime
' */
Public Function modify( _
    ByVal iInterval As String, _
    ByVal iNumber As Long, _
    Optional ByVal iByRef As Boolean = C_DEFAULT_BYREF _
) As DateTime
    With Me.clone
        Select Case UCase(iInterval)
            Case "YYYY", "YY":      .year = iNumber
            Case "M", "MM":         .month = iNumber
            Case "D", "DD":         .day = iNumber
            Case "H", "HH":         .hour = iNumber
            Case "N", "NN":         .minute = iNumber
            Case "S", "SS":         .second = iNumber
            Case "F":               .nanoSecond = iNumber
            Case "W":               .dayOfWeek = iNumber
            Case "WW":              .week = iNumber
            Case "Y":               .dayOfYear = iNumber
            Case Else:      Err.Raise 13, "DateTime.modify"
        End Select
        Set modify = retDt(.timestamp, .nanoSecond, iByRef)
    End With
End Function
 
'/**
' * Gibt ein DateTime nur mit dem Datum zurück
' * @param  Boolean     true: Das DateTimeObjekt wird selber verändert - False: Das Objekt selber wird nicht verändert
' * @return DateTime
' */
Public Function getDateObj(Optional ByVal iByRef As Boolean = C_DEFAULT_BYREF) As DateTime
    Set getDateObj = retDt(dateValue, 0, iByRef)
End Function
 
'/**
' * Gibt ein DateTime nur mit der Uhrzeit zurück (ohne Nanosekunden)
' * @param  Boolean     true: Das DateTimeObjekt wird selber verändert - False: Das Objekt selber wird nicht verändert
' * @return DateTime
' */
Public Function getTimeObj(Optional ByVal iByRef As Boolean = C_DEFAULT_BYREF) As DateTime
    Set getTimeObj = retDt(timeValue, 0, iByRef)
End Function
 
'/**
' * Gibt ein DateTime mit dem ersten Tag des Monates zurück. Analog zu trunc("D")
' * @param  Boolean     true: Das DateTimeObjekt wird selber verändert - False: Das Objekt selber wird nicht verändert
' * @return DateTime
' */
Public Function getFirstDayOfMonth(Optional ByVal iByRef As Boolean = C_DEFAULT_BYREF) As DateTime
    Set getFirstDayOfMonth = retDt(truncTimestamp("M"), 0, iByRef)
End Function
 
'/**
' * Gibt ein DateTime mit dem letzten Tag des Monates zurück
' * @param  Boolean     true: Das DateTimeObjekt wird selber verändert - False: Das Objekt selber wird nicht verändert
' * @return DateTime
' */
Public Function getLastDayOfMonth(Optional ByVal iByRef As Boolean = C_DEFAULT_BYREF) As DateTime
    Set getLastDayOfMonth = retDt(DateSerial(year, month + 1, 0), 0, iByRef)
End Function
 
'/**
' * Gibt ein DateTime mit dem ersten Tag der Woche zurück. Analog zu trunc("WW")
' * @param  Boolean     true: Das DateTimeObjekt wird selber verändert - False: Das Objekt selber wird nicht verändert
' * @return DateTime
' */
Public Function getFirstOfWeek(Optional ByVal iByRef As Boolean = C_DEFAULT_BYREF) As DateTime
    Set getFirstOfWeek = retDt(truncTimestamp("W"), 0, iByRef)
End Function
 
'/**
' * Gibt ein DateTime mit dem letzten Tag der Woche zurück
' * @param  Boolean     true: Das DateTimeObjekt wird selber verändert - False: Das Objekt selber wird nicht verändert
' * @return DateTime
' */
Public Function getLastDayOfWeek(Optional ByVal iByRef As Boolean = C_DEFAULT_BYREF) As DateTime
    Set getLastDayOfWeek = retDt(truncTimestamp("W") + 6, 0, iByRef)
End Function
 
'-------------------------------------------------------------------------------
' -- Public Properties
'-------------------------------------------------------------------------------
 
'/**
' * Setzt ein Property ung gibt ein DateTime zurück
' * @param  dtProperties    Info, welches Property gesetzt werden soll
' * @param  Variant         Wert
' * @param  Boolean         true: Das DateTimeObjekt wird selber verändert - False: Das Objekt selber wird nicht verändert
' * @return DateTime
' */
Public Function setProperty( _
        ByVal iProperty As dtProperties, _
        ByVal iValue As Variant, _
        Optional ByVal iByRef As Boolean = C_DEFAULT_BYREF _
) As DateTime
    Set setProperty = retDt(Me.timestamp, Me.nanoSecond, iByRef)
    Select Case iProperty
        Case dtpTimestamp:                  setProperty.timestamp = iValue
        Case dtpDateValue:                  setProperty.dateValue = iValue
        Case dtpTimeValue:                  setProperty.timeValue = iValue
        Case dtpYear:                       setProperty.year = iValue
        Case dtpMonth:                      setProperty.month = iValue
        Case dtpDay:                        setProperty.day = iValue
        Case dtpHour:                       setProperty.hour = iValue
        Case dtpMinute:                     setProperty.minute = iValue
        Case dtpSecond:                     setProperty.second = iValue
        Case dtpNanoSecond:                 setProperty.nanoSecond = iValue
        Case dtpMicroSecond:                setProperty.microSecond = iValue
        Case dtpMilliSecond:                setProperty.milliSecond = iValue
        Case dtpFirstWeekOfYear:            setProperty.firstWeekOfYear = iValue
        Case dtpFirstDayOfWeek:             setProperty.firstDayOfWeek = iValue
        Case dtpPatternDelemiter:           setProperty.patternDelemiter = iValue
        Case dtpDayOfWeek:                  setProperty.dayOfWeek = iValue
        Case dtpQuarter:                    setProperty.quarter = iValue
        Case dtpWeek:                       setProperty.week = iValue
        Case dtpDayOfYear:                  setProperty.dayOfYear = iValue
        Case dtpSqlTimeStamp:               setProperty.sqlTimeStamp = iValue
        Case dtpSqlDate:                    setProperty.sqlDate = iValue
        Case dtpSqlTime:                    setProperty.sqlTime = iValue
        Case dtpSqlFormat:                  setProperty.sqlFormat = iValue
        Case dtpReturnType:                 setProperty.returnType = iValue
        Case dtpSqlDateFormatString:        sqlDateFormatString = iValue
        Case dtpSqlDateTimeFormatString:    sqlDateTimeFormatString = iValue
        Case dtpSqlTimeFormatString:        sqlTimeFormatString = iValue
    End Select
End Function
 
' Ganzes Datum inkl. Zeit (rundung mit Nanosekunden)
Public Property Get timestamp() As Date:
    timestamp = IIf(CInt(pNanoSecond / 10 ^ 9) = 1, DateAdd("S", 1, pTimeStamp), pTimeStamp)
End Property
Public Property Let timestamp(ByVal its As Date):       pTimeStamp = its:                               End Property
' Nur Datum
Public Property Get dateValue() As Variant:             dateValue = VBA.dateValue(timestamp):           End Property
Public Property Let dateValue(ByVal its As Variant):    pTimeStamp = VBA.dateValue(getDate(its)):       End Property
'Nur Zeit
Public Property Get timeValue() As Variant:             timeValue = VBA.timeValue(timestamp):           End Property
Public Property Let timeValue(ByRef its As Variant):    pTimeStamp = VBA.timeValue(getDate(its)):       End Property
'Year
Public Property Get year() As Integer:                  year = VBA.year(timestamp):                     End Property
Public Property Let year(ByVal iYear As Integer):       replaceOnePart dptYear, iYear:                  End Property
'Month
Public Property Get month() As Integer:                 month = VBA.month(timestamp):                   End Property
Public Property Let month(ByVal iMonth As Integer):     replaceOnePart dptMonth, iMonth:                End Property
Public Property Get monthName() As String:              monthName = Me.format("MMMM"):                  End Property
'Day
Public Property Get day() As Integer:                   day = VBA.day(timestamp):                       End Property
Public Property Let day(ByVal iDay As Integer):         replaceOnePart dptDay, iDay:                    End Property
'Hour
Public Property Get hour() As Integer:                  hour = VBA.hour(timestamp):                     End Property
Public Property Let hour(ByVal iHour As Integer):       replaceOnePart dptHour, iHour:                  End Property
'Minute
Public Property Get minute() As Integer:                minute = VBA.minute(timestamp):                 End Property
Public Property Let minute(ByVal iMinute As Integer):   replaceOnePart dptMinute, iMinute:              End Property
'Second
Public Property Get second() As Integer:                second = VBA.second(timestamp):                 End Property
Public Property Let second(ByVal iSecond As Integer):   replaceOnePart dptSecound, iSecond:             End Property
'Nanosekunden: 10^-9  Vorsicht: Enthält auch Makro- und Millisekunden
Public Property Get nanoSecond() As Variant:            nanoSecond = pNanoSecond:                       End Property
Public Property Let nanoSecond(ByVal iNS As Variant):   pNanoSecond = iNS:                              End Property
'Mikrosekunden. 10^-6  Vorsicht: Enthält auch Millisekunden
Public Property Get microSecond() As Long:              microSecond = CLng(pNanoSecond / 10 ^ 3):       End Property
Public Property Let microSecond(ByVal iMS As Long):     pNanoSecond = iMS * 10 ^ 3:                     End Property
'Millisekunden. 10^-3
Public Property Get milliSecond() As Long:              milliSecond = CLng(pNanoSecond / 10 ^ 6):       End Property
Public Property Let milliSecond(ByVal iMS As Long):     pNanoSecond = iMS * 10 ^ 6:                     End Property
'Definition der ersten Kalenderwoche im Kalender
Public Property Get firstWeekOfYear() As VbFirstWeekOfYear: firstWeekOfYear = pFirstWeekOfYear:         End Property
Public Property Let firstWeekOfYear(ByVal ifW As VbFirstWeekOfYear): pFirstWeekOfYear = ifW:            End Property
'Erster Tag der Woche
Public Property Get firstDayOfWeek() As VbDayOfWeek:    firstDayOfWeek = pFirstDayOfWeek:               End Property
Public Property Let firstDayOfWeek(ByVal ifDW As VbDayOfWeek):    pFirstDayOfWeek = ifDW:               End Property
'Patterndemeliter. Default @
Public Property Get patternDelemiter() As String:        patternDelemiter = pPatternDelemiter:          End Property
Public Property Let patternDelemiter(ByVal iDelim As String): pPatternDelemiter = iDelim:               End Property
'DayOfWeek
Public Property Get dayOfWeek() As Integer
    dayOfWeek = CInt(VBA.format(timestamp, "W", firstDayOfWeek, firstWeekOfYear))
End Property
Public Property Let dayOfWeek(ByVal iDayOfWeek As Integer)
    'Für die Differnez wird extra nicht dayOfWeek genommen, sondern der Wochentag unabhängig von
    'den Einstellungen ermittelt, damit ein Wert aus dem Enum vbDayOfWeek zurückgegeben wird
    'Me.add (iDayOfWeek - dayOfWeek), True
    Me.add (iDayOfWeek - CInt(VBA.format(timestamp, "W"))), True
End Property
'Quarter
Public Property Get quarter() As Integer:               quarter = CInt(VBA.format(timestamp, "Q")):     End Property
Public Property Let quarter(ByVal iQuarter As Integer)
    Me.addSingleValue "Q", iQuarter - Me.quarter
End Property
'Week
Public Property Get week() As Integer
    week = getISOWeekNum(timestamp, firstDayOfWeek)
End Property
Public Property Let week(ByVal iWeek As Integer)
    Me.addSingleValue "WW", iWeek - Me.week
End Property
 
Public Property Get weekYear() As Integer
 
End Property
 
'DayOfWeekName
Public Property Get dayOfWeekName() As String:
    dayOfWeekName = Me.format("DDDD")
End Property
'DayOfYear
Public Property Get dayOfYear() As Long
    dayOfYear = CLng(VBA.format(pTimeStamp, "y", pFirstDayOfWeek, pFirstWeekOfYear))
End Property
Public Property Let dayOfYear(ByVal iDays As Long)
    trunc("YY").add iDays - 1
End Property
 
'Timestamp im SQL-Format
Public Property Get sqlTimeStamp() As String
    sqlTimeStamp = Me.format(sqlDateTimeFormatString)
End Property
Public Property Let sqlTimeStamp(ByVal iSqlString As String)
    pTimeStamp = Eval(iSqlString)
End Property
 
'Date im SQL-Format
Public Property Get sqlDate() As String
    sqlDate = Me.format(sqlDateFormatString)
End Property
Public Property Let sqlDate(ByVal iSqlString As String)
    pTimeStamp = Eval(iSqlString)
End Property
 
'Timest im SQL-Format
Public Property Get sqlTime() As String
    sqlTime = Me.format(sqlTimeFormatString)
End Property
Public Property Let sqlTime(ByVal iSqlString As String)
    pTimeStamp = Eval(iSqlString)
End Property
 
'-------------------------------------------------------------------------------
' -- Weitere Properties
'-------------------------------------------------------------------------------
 
'Definition des SQL-Formates
Public Property Get sqlFormat() As dtSqlFormats
    sqlFormat = pSqlFormat
End Property
Public Property Let sqlFormat(ByVal iSqlFormat As dtSqlFormats)
    pSqlFormat = Switch(andB(iSqlFormat, dtSqlIso8601), dtSqlIso8601, andB(iSqlFormat, dtsqlus), dtsqlus, andB(iSqlFormat, dtSqlManual), dtSqlManual, True, dtSqlDefault)
End Property
 
' Bei gewissen Methoden kann man das Rückgabetype auswählen
Public Property Get returnType() As dtReturnTypes
    returnType = pReturnTypes
End Property
Public Property Let returnType(ByVal iReturnType As dtReturnTypes)
    pReturnTypes = Switch(andB(iReturnType, dtDateTime), dtDateTime, andB(iReturnType, dtTimestamp), dtTimestamp, True, dtRetDefault)
End Property
 
'SQL Formatstring
Public Property Get sqlDateFormatString() As String
    sqlDateFormatString = Switch(sqlFormat = dtsqlus, C_SQL_DATE_US_FORMAT, sqlFormat = dtSqlIso8601, C_SQL_DATE_ISO8601_FORMAT, sqlFormat = dtSqlManual, pSqlDateFormatString)
End Property
Public Property Let sqlDateFormatString(ByVal iFormatString As String)
    pSqlDateFormatString = iFormatString
    sqlFormat = dtSqlManual
End Property
 
Public Property Get sqlDateTimeFormatString() As String
    sqlDateTimeFormatString = Switch(sqlFormat = dtsqlus, C_SQL_DATETIME_US_FORMAT, sqlFormat = dtSqlIso8601, C_SQL_DATETIME_ISO8601_FORMAT, sqlFormat = dtSqlManual, pSqlDateTimeFormatString)
End Property
Public Property Let sqlDateTimeFormatString(ByVal iFormatString As String)
    pSqlDateTimeFormatString = iFormatString
    sqlFormat = dtSqlManual
End Property
 
Public Property Get sqlTimeFormatString() As String
    sqlTimeFormatString = Switch(sqlFormat = dtsqlus, C_SQL_TIME_US_FORMAT, sqlFormat = dtSqlIso8601, C_SQL_TIME_ISO8601_FORMAT, sqlFormat = dtSqlManual, pSqlTimeFormatString)
End Property
Public Property Let sqlTimeFormatString(ByVal iFormatString As String)
    pSqlTimeFormatString = iFormatString
    sqlFormat = dtSqlManual
End Property
 
'/**
' * Gibt ein String-Wert eines Objektes zurück
' * @return String
' */
Public Property Get toString(Optional ByVal format As String) As String
    toString = IIf(format = Empty, sqlTimeStamp, Me.format(format))
End Property
 
'-------------------------------------------------------------------------------
' -- Interface methodes/properties
'-------------------------------------------------------------------------------
#If IFormattable_exists Then
    '/**
    ' * Gibt das Originalobjekt  zurück
    ' * @object
    ' */
    Private Property Get IFormattable_toString(Optional ByVal format As String, Optional ByRef formatProvider As Object) As String
        IFormattable_toString = toString(format)
    End Property
#End If
 
'-------------------------------------------------------------------------------
'--- PRIVATE PROPERTIES
'-------------------------------------------------------------------------------
'/**
' * Managt die gecachten Formate
' * @return Dictionary
' */
Private Property Get formatS() As Object
    Static cachedDict As Object
    If cachedDict Is Nothing Then Set cachedDict = CreateObject("scripting.Dictionary")
    Set formatS = cachedDict
End Property
 
 
'/**
' * RegExp der die Einzelformatpatterns bestimmt
' * @return RegExp
' */
Private Property Get rxParseFormat() As Object
    Static cachedRx As Object
    If cachedRx Is Nothing Then Set cachedRx = cRx("/((?=" & pPatternDelemiter & "?)(\\u[0-9A-F]{4})|(Y{4}|([MDHNSWYQ])\4|[MDHNSWYFQ]|A\/P|AM/PM))/ig")
    Set rxParseFormat = cachedRx
End Property
 
'/**
' * RegExp der die Einzelformatpatterns bestimmt
' * @return RegExp
' */
Private Property Get rxParseFormat2() As Object
    'cRx("/\{\$(.*?)\}/g")
    Static rx As Object:    If rx Is Nothing Then Set rx = cRx("/\{\$((\\u[0-9A-F]{4})|(Y{4}|([MDHNSWYQ])\4|[MDHNSWYFQ]|A\/P|AM/PM))}/ig")
    Set rxParseFormat2 = rx
End Property
 
Private Property Get rxExtractNanoSec() As Object
    Static rx As Object: If rx Is Nothing Then Set rx = cRx("/^(.*)(\.\d{1,9})$/")
    Set rxExtractNanoSec = rx
End Property
 
'/**
' * RegExp mit dem Nanosekundenformat
' * @return RegExp
' */
Private Property Get rxNS() As Object
    Static rx As Object: If rx Is Nothing Then Set rx = cRx("/(f{1,9})/ig")
    Set rxNS = rx
End Property
 
'/**
' * RegExp mit dem Nanosekundenformat bei format2()
' * @return RegExp
' */
Private Property Get rxNS2() As Object
    Static rx As Object: If rx Is Nothing Then Set rx = cRx("/(\{\$([^\}f]*))(f{1,9})(([^\}f]*)\})/i")
    Set rxNS2 = rx
End Property
 
'/**
' * RegExp um die Formatschnipsel bei format2() zu finden
' * @return RegExp
' */
Private Property Get rxFormats2() As Object
    Static rx As Object: If rx Is Nothing Then Set rx = cRx("/\{(?!\\)\$([^\}]+)}/")
    Set rxFormats2 = rx
End Property
 
'-------------------------------------------------------------------------------
' -- Private Methodes
'-------------------------------------------------------------------------------
 
'/**
' * Schneidet den Timestamp ab. Es wird ggf noch ein Delta dazu gerechnet
' * @param  String      Den Interval gemäss DateAdd()
' * @param  Byte        Ein Delta, dass auf der letzten Stelle dazugerecnet wird
' * @return Date
' */
Private Function truncTimestamp( _
        Optional ByVal iInterval As String = "D", _
        Optional ByVal iDelta As Integer = 0 _
) As Date
    Dim ts As Date: ts = timestamp
    Select Case UCase(iInterval)
        Case "YYYY", "YY", "Y": truncTimestamp = DateSerial(VBA.year(ts) + iDelta, 1, 1)
        Case "M", "MM":         truncTimestamp = DateSerial(VBA.year(ts), VBA.month(ts) + iDelta, 1)
        Case "D", "DD":         truncTimestamp = DateSerial(VBA.year(ts), VBA.month(ts), VBA.day(ts) + iDelta)
        Case "H", "HH":         truncTimestamp = DateSerial(VBA.year(ts), VBA.month(ts), VBA.day(ts)) + TimeSerial(VBA.hour(ts) + iDelta, 0, 0)
        Case "N", "NN":         truncTimestamp = DateSerial(VBA.year(ts), VBA.month(ts), VBA.day(ts)) + TimeSerial(VBA.hour(ts), VBA.minute(ts) + iDelta, 0)
        Case "S", "SS":
            'Die Nanosekunden sind bereits eingearbeitet. Darum müssen diese wieder entfernt werden
            iDelta = iDelta - CInt(nanoSecond / 10 ^ 9)
            truncTimestamp = DateSerial(VBA.year(ts), VBA.month(ts), VBA.day(ts)) + TimeSerial(VBA.hour(ts), VBA.minute(ts), VBA.second(ts) + iDelta)
        Case "W", "WW":         truncTimestamp = DateAdd("d", -CInt(VBA.format(ts, "w", pFirstDayOfWeek)) + 1, DateAdd("WW", iDelta, truncTimestamp("D")))
        Case Else:      Err.Raise 13, "DateTime.trunc"
    End Select
End Function
 
'/**
' * Ersezt einen einzelnen Teil des Timestamp
' * @param  String  Kurzzeichen des Abschnittes YMDHNS
' * @param  Integer Neuer Wert
' */
Private Sub replaceOnePart(ByVal iDatePartType As enuDatePartType, ByVal iValue As Integer)
    Select Case iDatePartType
        Case dptYear:       pTimeStamp = DateSerial(iValue, Me.month, Me.day) + Me.timeValue
        Case dptMonth:      pTimeStamp = DateSerial(Me.year, iValue, Me.day) + Me.timeValue
        Case dptDay:        pTimeStamp = DateSerial(Me.year, Me.month, iValue) + Me.timeValue
        Case dptHour:       pTimeStamp = Me.dateValue + TimeSerial(iValue, Me.minute, Me.second)
        Case dptMinute:     pTimeStamp = Me.dateValue + TimeSerial(Me.hour, iValue, Me.second)
        Case dptSecound:    pTimeStamp = Me.dateValue + TimeSerial(Me.hour, Me.minute, iValue)
    End Select
End Sub
 
'/**
' * Versucht aus einer Eingabe ein Datum zu erstellen
' * @param  Date/DateTime/String
' * @return Date
' */
Private Function getDate(ByRef iDate As Variant) As Date
    Select Case TypeName(iDate)
        Case "DateTime":    getDate = iDate.timestamp
        Case "Date":        getDate = iDate
        Case "String":      getDate = dateValue(iDate) + timeValue(dateValue)
        Case "Null":        getDate = Now
        Case Else:          Err.Raise 13, "DateInterval.getDate"          '13  Type mismatch
    End Select
End Function
 
'/**
' * Handelt den Return. Ob das aktuelle Objekt angepasst wird oder nicht
' * @param  Date
' * @param  Boolean     true: Das DateTimeObjekt wird selber verändert - False: Das Objekt selber wird nicht verändert
' * @return DateTime
' */
Private Function retDt(ByVal iTimestamp As Date, ByVal iNanoSecond As Variant, ByVal iByRef As Boolean) As DateTime
    If iByRef Then
        'Auf sich selber anpassen
        pTimeStamp = iTimestamp
        pNanoSecond = iNanoSecond
        Set retDt = Me
    Else
        'Neues Objekt erstellen. Die SQL-Formateinstellung wird ebenfalls übergeben
        Set retDt = DateTime.instance(iTimestamp, , Me.sqlFormat, firstDayOfWeek, firstWeekOfYear)
        retDt.nanoSecond = iNanoSecond
    End If
End Function
 
Private Sub refDt(ByRef oValue As Variant, ByVal iReturnType As dtReturnTypes, Optional ByRef iDt As DateTime = Nothing, Optional ByVal iByRef As Boolean = C_DEFAULT_BYREF)
    Dim dt As DateTime: Set dt = IIf(iDt Is Nothing, Me, iDt)
    Select Case iReturnType
        Case dtTimestamp:   oValue = dt.timestamp
        Case dtDateTime:    Set oValue = IIf(iByRef, dt, dt.clone)
    End Select
End Sub
 
'/**
' * Add/Minus ein DateInterval
' * @param  DateInterval/IntervalSpec/Days
' * @param  Boolean                             true: Das DateTimeObjekt wird selber verändert - False: Das Objekt selber wird nicht verändert
' * @return DateTime
' */
Private Function addInterval(ByRef iInterval As Variant, ByVal iSign As Integer, Optional ByVal iByRef As Boolean = C_DEFAULT_BYREF) As DateTime
    Dim di As DateInterval
    Select Case TypeName(iInterval)
        Case "DateInterval":    Set di = iInterval
        Case "String":          Set di = DateInterval(iInterval)
        Case "Integer", "Long": Set di = DateInterval(iInterval)
        Case Else:              Err.Raise 13, "DateTime.addInterval"
    End Select
    Dim sign As Integer:    sign = di.sign * iSign
    Dim ts As Date:         ts = pTimeStamp
    Dim nanoSec As Long:    nanoSec = pNanoSecond + sign * di.nanoSecond
    ts = DateAdd("YYYY", sign * di.year, ts)
    ts = DateAdd("M", sign * di.month, ts)
    ts = DateAdd("D", sign * di.day, ts)
    ts = DateAdd("H", sign * di.hour, ts)
    ts = DateAdd("N", sign * di.minute, ts)
    ts = DateAdd("S", sign * di.second, ts)
 
    Set addInterval = retDt(ts, nanoSec, iByRef)
End Function
 
'/**
' * Ermittelt den Jahrestag des Ersten Tages einer Woche
' * @param  Long    Jahr
' * @param  Integer Woche im Jahr
' * @param  VbDayOfWeek             Angabe zum ersten Wochentag. Schweiz -> Montag
' * @param  VbFirstWeekOfYear       Angabe zum ersten Woche im Jahr
' * @return Long
' */
Private Function getDaysOfFirstDayOfWeek( _
        ByVal iYear As Long, _
        ByVal iWeek As Integer, _
        Optional ByVal iFirstDayOfWeek As VbDayOfWeek = vbUseSystemDayOfWeek, _
        Optional ByVal iFirstWeekOfYear As VbFirstWeekOfYear = vbUseSystem _
) As Long
    Dim firstJan  As Date:      firstJan = DateSerial(iYear, 1, 1)
    Dim firstJanW As Integer:   firstJanW = DatePart("W", firstJan, iFirstDayOfWeek, vbFirstFullWeek)
    Dim diff As Integer:        diff = IIf(DatePart("WW", firstJan, iFirstDayOfWeek, iFirstWeekOfYear) = 1, firstJanW, firstJanW - 7)
    getDaysOfFirstDayOfWeek = ((iWeek - 1) * 7) + 2 - diff
End Function
 
'-------------------------------------------------------------------------------
' -- Class Events
'-------------------------------------------------------------------------------
 
'/**
' * Beim initialisieren gleich den Wert auf Now setzen
' */
Private Sub Class_Initialize()
    pPatternDelemiter = C_DEFAULT_PATTERN_DELEMITER
    construct Now
End Sub
 
'-------------------------------------------------------------------------------
'--- LIBRARIES
'-------------------------------------------------------------------------------
 
'-------------------------------------------------------------------------------
' -- strToDate V 2.5.0
'-------------------------------------------------------------------------------
 
'/**
' * Parst ein String in ein Datum anhand eines mitgegeben Formates
' * @param  String                  Der Datumsstring
' * @param  String                  Das Format. Als Standart ist das Systemdatumsformat
' * @param  tdtParams               Weitere Parameter
' * @param  VbDayOfWeek             Angabe zum ersten Wochentag. Schweiz -> Montag. Standard: Systemeinstellung
' * @param  VbFirstWeekOfYear       Angabe zum ersten Woche im Jahr. Schweiz -> vbFirstFourDays. Standard: Systemeinstellung
' * @param  Long                    Rückgabewert für die Nanosekunden
' * @return Date
' *
' * Die folgenden Zeichen müssen im Format mit einem \ maskiert werden, wenn sie als Trennzeichen eingesetzt werden sollen:
' * M D Y H N S W @    Bie AMPM: A\M/P\M, \A/P
' * Bsp.:   strToDate("D01M11Y2014", "\DDD\MMM\YYYYY") -> 1 November 2014
' *
' * Bisher umgesetzte Formate:
' * m       Monat ohne führende Null (1-12)
' * mm      Monat mit führende Null (01-12)
' * d       Tag ohne führende Null (1-31)
' * dd      Tag mit führende Null (01-31)
' * yy      Zweistelliges Jahr
' * yyyy    Vierstelliges Jahr
' * q       QuartalAnfang (1.1.x - 1.10.x)
' * qq      QuartalEnde   (31.3.x - 31.12.x)
' * h       Stunden ohne führende Null(0-24)
' * hh      Stunden mit führende Null(00-24)
' * n       Minuten ohne führende Null(0-59)
' * nn      Minuten mit führende Null(00-59)
' * s       Sekunden ohne führende Null(0-59)
' * ss      Sekunden mit führende Null(00-59)
' * am/pm   Erwartet eine Angabe von AM oder PM
' * a/p     Erwartet eine Angabe von A oder P
' * y       Tag des Jahres
' * w       Tag der Woche
' * ww      Woche im Jahr
' * f       Nanosekunden
' *
' * Allgemein. Sollte anhand des Formates eine Reihenfolge nicht klar sein, dann kann vor jedes Pattern ein @ gesetzt werden
' * Format "YYYYY". Jahreszahl & Tag im Jahr. Es ist unklar ob das Jahr oder der Tag als erste kommt. -> "Y2YYYY"
' *
' * Errors:
' * 13          Es wurde kein Format mitgegeben und der String lässt sich nicht durch das Sytem in ein Datum wandeln. Siehe cdate()
' * -2147221503 (C_SD_ERR_INVALID_FORMAT)   Das Format ist nicht parsbar
' * -2147221502 (C_SD_ERR_NOT_PARSEBLE)     Der String passt nicht mit dem Format überein
' */
Public Function strToDate( _
        ByVal iDate As Variant, _
        Optional ByVal iFormat As String = vbNullString, _
        Optional ByVal iparams As tdtParams = tdtIgnoreCase, _
        Optional ByVal iFirstDayOfWeek As VbDayOfWeek = vbUseSystemDayOfWeek, _
        Optional ByVal iFirstWeekOfYear As VbFirstWeekOfYear = vbUseSystem, _
        Optional ByRef oNanoSecounds As Variant _
) As Variant
On Error GoTo Err_Handler
 
    Dim dateS As String:     dateS = IIf(andB(iparams, tdtIgnoreCase), UCase(CStr(NZ(iDate))), CStr(NZ(iDate)))
    'Wenn kein Format mitgegen wird, wird versucht mittels cDate() das Datum herauszukriegen
    If iFormat = vbNullString Then
        strToDate = CDate(dateS)
        Exit Function
    End If
 
    Dim d As Integer, m As Integer, y As Integer: d = 1: m = 0: y = 0
    Dim h As Integer, n As Integer, s As Integer: h = 0: n = 0: s = 0
    Dim dow As Integer, doy As Long, woy As Integer: dow = 0: doy = 0: woy = 0
    Dim ampm As String
    Dim flagHasDate As Boolean
    Dim flagHasTime As Boolean
 
    'überprüfen, welcher Art von Format es ist
    If Not andB(iparams, tdtFomat2) And rxParseFormat2.test(iFormat) Then iparams = iparams + tdtFomat2
 
    'Format parsen
    Dim frmtKey As String: frmtKey = parseFormatToCache(iFormat, iparams)
 
    'Überprüfen ob der Datumsstring auf das Format passt
    If formatS(frmtKey).item("RegExp").test(dateS) = False Then Err.Raise dtErrNotParseble, "strToDate", "Datum passt nicht auf das Format" & vbCrLf & vbCrLf & formatS(frmtKey).item("RegExp").pattern
 
    Dim match As Object: Set match = formatS(frmtKey).item("RegExp").execute(dateS)(0)
    Dim i As Integer: For i = 0 To match.subMatches.Count - 1
        Dim sm As String: sm = match.subMatches(i)
        Dim parser As tdParser: parser = formatS(frmtKey).item("codePos")(i)
        flagHasDate = (andB(pcDate, parser) Or flagHasDate)
        flagHasTime = (andB(pcTime, parser) Or flagHasTime)
        Select Case parser
            Case pcDay:         d = sm
            Case pcMonth:       m = sm
            Case pcYear:        y = sm
            Case pcHour:        h = sm
            Case pcMinute:      n = sm
            Case pcSecound:     s = sm
            Case pcAmPm:        ampm = UCase(Left(sm, 1))
            Case pcDayOfYear:   doy = sm
            Case pcDayOfWeek:   dow = sm
            Case pcWeekOfYear:  woy = sm
            Case pcNonosecound: oNanoSecounds = 10 ^ 9 * CDbl("0." & sm)
            Case pcQuarterEnd:  d = 0: m = sm * 3 + 1
            Case pcQuarter:     d = 1: m = (sm - 1) * 3 + 1
        End Select
    Next i
 
    'Spezialfälle, welche bestehende Grössen überschreiben
    If doy <> 0 Then        'Tag des Jahres
        m = 1               'Monat auf Januar setzen
        d = doy             'Tag des Jehres als Tag übernehmen
    ElseIf woy <> 0 Then    'Woche des Jahres
        m = 1               'Monat auf Januar setzen
        d = getDaysOfFirstDayOfWeek(y, woy, iFirstDayOfWeek, iFirstWeekOfYear) + IIf(dow = 0, 0, (dow - 1))
    End If
 
    'AM/PM Stundenkorrektur
    If ampm = "P" And h <> 0 And h < 12 Then
        h = h + 12
    ElseIf ampm = "A" And h = 12 Then
        h = 0
    End If
 
    strToDate = IIf(flagHasDate, DateSerial(y, m, d), 0) + IIf(flagHasTime, TimeSerial(h, n, s), 0)
 
    Set match = Nothing
 
Exit_Handler:
    Set match = Nothing
    Exit Function
Err_Handler:
    If Not andB(iparams, tdtIgnoreError) Then Err.Raise Err.Number, Err.source, Err.Description, Err.HelpFile, Err.helpContext
    strToDate = Null
    Resume Exit_Handler
    Resume
End Function
 
'-------------------------------------------------------------------------------
'--- PRIVATE METHODES
'-------------------------------------------------------------------------------
 
'/**
' * Zerlegt das Format in seine Einzelteile und erstellt ein RegEx-Pattern umd den Datumsstring zu zerlegen
' * @param  String      Das Format. Als Standart ist das Systemdatumsformat
' * @param  tdtParams   Weitere Parameter
' * @return String      Key des gecachten RegExp
' */
Private Function parseFormatToCache(ByVal iFormat As String, ByVal iparams As tdtParams) As String
    parseFormatToCache = iFormat & "_P" & iparams
    'Das Format nur zerlegen, wenn es noch nicht exisiteiert
    If Not formatS.exists(parseFormatToCache) Then
        Dim codePosR() As tdParser
 
        Dim frmt As String:         frmt = IIf(andB(iparams, tdtIgnoreCase), UCase(iFormat), iFormat)
        Dim pattern As String:
 
        Dim rxPF As Object
        If Not andB(iparams, dtInFormatFormat2) Then
            pattern = masked2uniode(frmt)
            pattern = rxEscapeString(pattern)
            Set rxPF = rxParseFormat
        Else
            pattern = frmt
            Set rxPF = rxParseFormat2
        End If
        If rxPF.test(pattern) = False Then Err.Raise dtErrInvalidFormat, "strToDate", "Ungültiges Datumsformat"
        Dim mc As Object:  Set mc = rxPF.execute(pattern)
 
        Dim idxPos As Integer:      idxPos = -1
        Dim i As Integer:           For i = mc.Count - 1 To 0 Step -1
            Dim item As String:     item = mc(i).subMatches(2)
            If Not item = Empty Then 'Ist kein Maskiertes Zeichen
                idxPos = idxPos + 1: ReDim Preserve codePosR(idxPos)
                pattern = substrReplace(pattern, convertFormatPattern(item, codePosR(idxPos)), mc(i).firstIndex, mc(i).length)
            End If
        Next i
        'Patterntrennzeichen entfernen
        pattern = Replace(pattern, C_PATTERN_DELEMITER, "")
        'Reihenfolge der codePosR umdrehen
        Dim codePos() As String:    ReDim codePos(idxPos)
        For i = 0 To idxPos
            codePos(i) = codePosR(idxPos - i)
        Next i
        pattern = unicodeDecode(pattern)
        If Not andB(iparams, tdtExtractDate) Then pattern = "^" & pattern & "$"
        pattern = "/" & pattern & "/" & IIf(andB(iparams, tdtIgnoreCase), "i", "")
 
        formatS.add parseFormatToCache, CreateObject("scripting.Dictionary")
        'RegExp zu diesem Pattrn erstellen
        formatS(parseFormatToCache).add "codePos", codePos      'Index der SubMatches
        formatS(parseFormatToCache).add "RegExp", cRx(pattern)
    End If
End Function
 
'/**
' * Maskiert einen String, damit er keine Pattern darstellt
' * @param  String
' * @return String
' */
Private Function rxEscapeString(ByVal iString As String) As String
    Static rx As Object
    If rx Is Nothing Then Set rx = cRx("/([\*\+\?\|\{\[\(\)\^\.\$])/gi")    '\ wird nicht maskiert
    rxEscapeString = rx.Replace(iString, "\$1")
End Function
 
'/**
' * Konvertiert ein gefundenen Formatteil in ein RX-Pattern. Gibt Zugleich den Datumsparser zurück
' * @param  String
' * @param  tdParser
' * return  String
' */
Private Function convertFormatPattern(ByVal iString As String, ByRef oCode As tdParser) As String
    Select Case UCase(iString)
        Case "D":       convertFormatPattern = "(\d{1,2})":     oCode = pcDay
        Case "DD":      convertFormatPattern = "(\d{2})":       oCode = pcDay
        Case "M":       convertFormatPattern = "(\d{1,2})":     oCode = pcMonth
        Case "MM":      convertFormatPattern = "(\d{2})":       oCode = pcMonth
        Case "YY":      convertFormatPattern = "(\d{2}|\d{4})": oCode = pcYear
        Case "YYYY":    convertFormatPattern = "(\d{4})":       oCode = pcYear
        Case "H":       convertFormatPattern = "(\d{1,2})":     oCode = pcHour
        Case "HH":      convertFormatPattern = "(\d{2})":       oCode = pcHour
        Case "N":       convertFormatPattern = "(\d{1,2})":     oCode = pcMinute
        Case "NN":      convertFormatPattern = "(\d{2})":       oCode = pcMinute
        Case "S":       convertFormatPattern = "(\d{1,2})":     oCode = pcSecound
        Case "SS":      convertFormatPattern = "(\d{2})":       oCode = pcSecound
        Case "AM/PM":   convertFormatPattern = "(AM|PM)":       oCode = pcAmPm
        Case "A/P":     convertFormatPattern = "([AP])":        oCode = pcAmPm
        Case "Y":       convertFormatPattern = "(\d{1,3})":     oCode = pcDayOfYear
        Case "W":       convertFormatPattern = "([1234567])":   oCode = pcDayOfWeek
        Case "WW":      convertFormatPattern = "(\d{1,2})":     oCode = pcWeekOfYear
        Case "F":       convertFormatPattern = "(\.?\d{1,9})":  oCode = pcNonosecound
        Case "QQ":      convertFormatPattern = "([1-4])":       oCode = pcQuarterEnd
        Case "Q":       convertFormatPattern = "([1-4])":       oCode = pcQuarter
    End Select
End Function
 
'-------------------------------------------------------------------------------
'--- PRIVATE PROPERTIES
'-------------------------------------------------------------------------------
 
'-------------------------------------------------------------------------------
'--- LIBRARIES
'-------------------------------------------------------------------------------
 
'/**
' * Dies ist die Minimalversion von cRx (V2.1.0): http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cRx
' */
Private Function cRx(ByVal iPattern As String) As Object
    Static rxP As Object
    If rxP Is Nothing Then:     Set rxP = CreateObject("VBScript.RegExp"): rxP.pattern = "^([@&!/~#=\|])?(.*)\1(?:([Ii])|([Gg])|([Mm]))*$"
    Dim sm As Object:           Set cRx = CreateObject("VBScript.RegExp"): Set sm = rxP.execute(iPattern)(0).subMatches
    cRx.pattern = sm(1):        cRx.IgnoreCase = Not isEmpty(sm(2)):       cRx.Global = Not isEmpty(sm(3)):     cRx.Multiline = Not isEmpty(sm(4))
End Function
 
'/**
' * Copyright mpl by ERB software | http://wiki.yaslaw.info
' *
' * Wandelt ein Unicode in ein Charakter
' * @example: unicode2char("\u20AC") -> '\€'
' * @param  String      Unicode
' * @return String      Char
' */
Private Function unicode2Char(ByVal iUnicode As String) As String
    unicode2Char = ChrW(Replace(iUnicode, "\u", "&h"))
End Function
 
'/**
' * Copyright mpl by ERB software | http://wiki.yaslaw.info
' *
' * Wandelt ein Charakter in ein Unicode
' * @example: char2unicode("€") -> '\u20AC'
' * @param  String(1)   Charakter, der gewandelt werden soll
' * @return String      Unicode
' */
Private Function char2unicode(ByVal iChar As String) As String
    char2unicode = Hex(AscW(iChar)) 'Hex-Wert ermitteln
    char2unicode = "\u" & String(4 - Len(char2unicode), "0") & char2unicode
End Function
 
'/**
' * Wandelt jedes mit \ maskierte Feld in Unicode um, ausser es handelt sich bereits um einen Unicode
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/masked2unicode
' * @param  String
' * @return String
' */
Private Function masked2uniode(ByVal iString As String) As String
    Static rx As Object:    If rx Is Nothing Then Set rx = cRx("/\\(?!u[0-9A-F]{4})(.)/")
    masked2uniode = iString
    Do While rx.test(masked2uniode)
        masked2uniode = rx.Replace(masked2uniode, char2unicode(rx.execute(masked2uniode)(0).subMatches(0)))
    Loop
End Function
 
'/**
' * Wandelt alle Unicodes in einem String in das eigentliche Zeichen zurück
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/unicodedecode
' * @param  String
' * @return String
' */
Private Function unicodeDecode(ByVal iString) As String
    unicodeDecode = iString
    Static rx As Object
    If rx Is Nothing Then Set rx = cRx("/\\u[0-9A-F]{4}/g")
    If Not rx.test(unicodeDecode) Then Exit Function
    Dim mc As Object:   Set mc = rx.execute(unicodeDecode)
    Dim i As Integer:   For i = mc.Count - 1 To 0 Step -1
        unicodeDecode = substrReplace(unicodeDecode, unicode2Char(mc(i)), mc(i).firstIndex, mc(i).length)
    Next i
End Function
 
'/**
' * Ersetzt Text innerhalb einer Zeichenkette
' * @param  String      Die Eingabezeichenkette
' * @param  String      Die Ersetzungszeichenkette
' * @param  Integer     Start
' * @param  Integer     Länge
' * @return String
' */
Private Function substrReplace(ByVal iString As String, ByVal iReplacement As String, ByVal iStart As Integer, Optional ByVal iLength As Variant = Null) As String
    Dim startP As Integer:  startP = IIf(Sgn(iStart) >= 0, iStart, greatest(Len(iString) + iStart, 1))
    Dim length As Integer:  length = NZ(iLength, Len(iString) - iStart)
    Dim endP   As Integer
 
    Select Case Sgn(length)
        Case 1:     endP = least(startP + length, Len(iString))
        Case 0:     endP = startP
        Case -1:    endP = greatest(Len(iString) + length, startP)
    End Select
 
    substrReplace = Left(iString, startP) & iReplacement & Mid(iString, endP + 1)
 
End Function
 
'/**
' * Copyright mpl by ERB software | http://wiki.yaslaw.info
' *
' * Gibt den Grössten aus einer unbestimmten Menge von Werten zurück
' * @param  Keine Objekte
' * @return Grösster Wert
' * @example greatest("Hallo Welt", 42, "Mister-X") -> Mister-X
'*/
Private Function greatest(ParamArray iItems() As Variant) As Variant
    greatest = iItems(UBound(iItems))
    Dim item As Variant: For Each item In iItems
        If NZ(item) > NZ(greatest) Then greatest = item
    Next item
End Function
 
'/**
' * Gibt den Kleinsten aus einer unbestimmten Menge von Werten zurück
' * @param  Keine Objekte
' * @return Grösster Wert
' * @example least("Hallo Welt", 42, "Mister-X") -> 42
'*/
Private Function least(ParamArray iItems() As Variant) As Variant
    least = iItems(LBound(iItems))
    Dim item As Variant: For Each item In iItems
        If NZ(item) < NZ(least) Then least = item
    Next item
End Function
 
'// Provided by Daniel Maher.
Private Function getISOWeekNum(ByVal iDate As Date, Optional ByVal iFirstDayOfWeek As VbDayOfWeek = vbUseSystemDayOfWeek, Optional ByVal iFirstWeekOfYear As VbFirstWeekOfYear = vbUseSystem) As Integer
   Dim tempDate As Date
   tempDate = DateSerial(VBA.year(iDate - DatePart("W", iDate - 1, iFirstDayOfWeek, iFirstWeekOfYear) + 4), 1, 3)
   getISOWeekNum = Int((iDate - tempDate + DatePart("W", tempDate, iFirstDayOfWeek, iFirstWeekOfYear) + 5) / 7)
End Function
 
'/**
' * Macht einen Bit-Vergleich
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/andb
' * @param  Long
' * @param  Long
' * @return Boolean
' */
Private Function andB(ByVal iHaystack As Long, ByVal iNeedle As Long) As Boolean
    andB = ((iHaystack And iNeedle) = iNeedle)
End Function
 
#If Not isAccess Then
    '/**
    ' * Wandelt NULL in EMpty oder einen Defaultwert
    ' * @param  Variant
    ' * @param  Variant
    ' * @return Variant
    ' */
    Private Function NZ(ByRef iValue As Variant, Optional ByRef iDefault As Variant = Empty) As Variant
        If IsNull(iValue) Then
            NZ = iDefault
        Else
            NZ = iValue
        End If
    End Function
#End If
 
 
1) , 2) , 3) , 4) , 5)
1 bzw. 2 Stellige Zahl
6)
2 bzw. 4 Stellige Zahl
7)
Seit Version 1.8.0 nicht mehr
vba/classes/date/datetime/index.txt · Last modified: 04.07.2016 10:46:14 by yaslaw