Diese Funktion parst ein String in ein Date. Im Gegensatz zu cDate() von VBA kann hier das Datumsformat mitgegeben werden. Die meisten Formatzeichen von VBA werden unterstüzt.

Download cast_strtodate.bas (V-2.3.0)

Um die Funktion bei mehrmaliger Anwendung zu beschleunigen, werden die RegExp-Objekte mit den generierten Pattern in ein privates Dictionary-Objekt gespeichert. Das führt zu einer erheblichen Geschwindigkeitsverbesserung bei der Anwendung innerhalb eines SQL-Statements

date = strToDate(string [,format [,parameters]])

Public Function strToDate( _
        ByVal iDateS As String, _
        Optional ByVal iFormat As String = vbNullString, _
        Optional ByVal iParams As tdtParams = tdtIgnoreCase _
) As Date

• iDateS Der Datumsstring, der in ein Datum geparst werden soll
• iFormat Das Datumsformat. Wird eines der folgenden Zeichen als Trennzeichen verwendet, muss es mit einem \ maskiert werden (siehe Beispiele): M D Y H N S
• iParams Weitere Parameter. Siehe dazu der Enumerator tdtParams. DIese sind mit + kombinierbar. Default ist tdtIgnoreCase

Public Enum tdtParams
    tdtNone = 0
    tdtIgnoreCase = 2 ^ 0   'Gross-Kleinschreibung bei Trennzeichen ignorieren
    tdtExtractDate = 2 ^ 1  'Der String beimnhaltet vor oder nach dem Datum noch andere Werte. Das Datum wird extrahiert
    tdtIgnoreError = 2 ^ 2  'Fehler werden ignoriert. Im Fehlerfall wird NULL zurückgegeben
End Enum

Excel kennt leider die lebenswichtige Funktion NZ() nicht. Darum muss für Excel diese Funktion hinzuprogrammiert sein. Das steurt man über die Kompilierungskonstante isAccess

Am Anfang vom Code befindet sich darum die Zeile
Für Access ist dies True, für Excel False

#Const isAccess = True

Hier einige Anwendungsbeispiele

Für die Ausgabe der Resultate verwendete ich die Funktion [VBA] print_r().

'Ohne Format. Es wird intern cDate angewendet
print_r strToDate("5.9.2013")
<Date> 05.09.2013
 
'Mit dem Format den Tag und Monat genau zuordnern. Damit aus 5.9 der 9te Mai wird
print_r strToDate("5.9.2013", "m.d.yyyy")
<Date> 09.05.2013
 
'Einen String ohne Trennzeichen
print_r strToDate("05092013", "mmddyyyy")
<Date> 09.05.2013
 
'und mit Uhrzeit
print_r strToDate("05092013_151765", "mmddyyyy_hhnnss")
<Date> 09.05.2013 15:18:05
 
'und mit AM/PM
print_r strToDate("05092013_121765_AM", "mmddyyyy_hhnnss_am/pm")
<Date> 09.05.2013 00:18:05
 
'nur die Zeit
print_r strToDate("17:6:65", "h:n:s")
<Date> 17:07:05
 
'Mit Trennzeichen, die auch Formate sind. Darum müsse diese Zeichen im Format mit einem \ maskiert werden
'Das Format ist: D gefolgt vom Tag (1-31), M gefolgt von einem Monat (01-12) und Y gefolgt vom Jahr
print_r strToDate("D1M05Y2013", "\DD\MMM\YYYYY")
<Date> 01.05.2013
 
'Ohne tdtExtractDate
print_r strToDate("Heute ist der 1.12.2014", "d.m.yyyy")
-> Fehler -2147221502
 
'Mit tdtExtractDate
print_r strToDate("Heute ist der 1.12.2014", "d.m.yyyy", tdtExtractDate)
<Date> 01.12.2014
 
'Mit tdtExtractDate, ohne tdtIgnoreCase. Man beachte, der 'Monat' ist im Format klein geschrieben (und maskiert)
print_r strToDate("Heute ist der 1te des 12ten Monats 2014", "dte \de\s mte\n \mo\nat\s yyyy", tdtExtractDate)
-> Fehler -2147221502
 
'Und kombiniert mit tdtIgnoreCase
print_r strToDate("Heute ist der 1te des 12ten Monats 2014", "dte \de\s mte\n \mo\nat\s yyyy", tdtExtractDate + tdtIgnoreCase)
<Date> 01.12.2014

Noch ein kleines Beispiel zum umformatieren eines Datum-Strings in ein anderer. Das brauche ich häufig wenn ich mit Schnittstellen zu anderen System arbeite.
In dem Beispiel habe ich ein Datum im Format ddmmyyyy. Für das andere System brauche ich das Format m/d/yyyy, wobei hier / nicht für den Loakalen Seperator steht, sondern für den String /. Darum muss er für den VBA-Befehl format() mit \ maskiert werden.

print_r format(strToDate("01061972", "ddmmyyyy"), "m\/d\/yyyy")
<String> '6/1/1972'

cast_strtodate.bas

Attribute VB_Name = "cast_strToDate"
'-------------------------------------------------------------------------------
'File         : cast_strToDate.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/strtodate
'Environment  : VBA 2007 +
'Version      : 2.5.0
'Name         : strToDate
'Author       : Stefan Erb (ERS)
'History      : 13.11.2013 - ERS - Creation
'             : 22.01.2014 - ERS - Platzhalterzeichen als Trennzeichen erlaubt
'               ...
'               07.09.2015 - ERS - Null und Zahlen als Input zugelassen
'               29.09.2015 - ERS - Berechnungsfehler bei w und ww mit vbFirstFullWeek behoben
'               17.11.2015 - ERS - q und qq hinzugefügt
'               15.03.2016 - ERS - Format2 hinzugefügt. Also Formate in {$..}
'-------------------------------------------------------------------------------
'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
 
Option Explicit
'-------------------------------------------------------------------------------
' -- ! SETTINGS !
'-------------------------------------------------------------------------------
 
 
'   date = strToDate(string [,format [,parameters [,erster Tag der Woche [,erste Woche des Jahres [,nanosekunden]]]]])
 
'-------------------------------------------------------------------------------
'--- PUBLIC MEMBERS
'-------------------------------------------------------------------------------
 
'/**
' * Zusätzliche Parameters zu strToDate
' */
Public Enum tdtParams
    tdtNone = 0
    tdtIgnoreCase = 2 ^ 0   'Gross-Kleinschreibung bei Trennzeichen ignorieren
    tdtExtractDate = 2 ^ 1  'Der String beimnhaltet vor oder nach dem Datum noch andere Werte. Das Datum wird extrahiert
    tdtIgnoreError = 2 ^ 2  'Fehler werden ignoriert. Im Fehlerfall wird NULL zurückgegeben
    tdtFomat2 = 2 ^ 3       'Es handelt sich um ein Format im Stil von {$DD}.{$MM}
End Enum
 
'/**
' * Public Konstanten
' */
Public Const C_PATTERN_DELEMITER = "@"     'Fakultatives Patterntrennzeichen
 
'/**
' * Error Konstantens
' */
Public Const C_SD_ERR_INVALID_FORMAT = -2147221504 + 1  'Das Format ist nicht parsbar
Public Const C_SD_ERR_NOT_PARSEBLE = -2147221504 + 2    'Der String passt nicht mit dem Format überein
 
'-------------------------------------------------------------------------------
'--- PUBLIC METHODES
'-------------------------------------------------------------------------------
 
'/**
' * 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
' * Bsp.:   strToDate("D01M11Y2014", "D{$DD}M{$MM}Y{$YYYY}") -> 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 Long _
) As Variant
On Error GoTo Err_Handler
 
    Dim dates As String:     dates = IIf((iParams And 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 = 0: 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
 
    'überprüfen, welcher Art von Format es ist
    If Not (iParams And tdtFomat2) = 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 C_SD_ERR_NOT_PARSEBLE, "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)
        Select Case formats(frmtKey).item("codePos")(i)
            Case "DAY":             d = sm
            Case "MONTH":           m = sm
            Case "YEAR":            y = sm
            Case "HOUR":            h = sm
            Case "MINUTE":          n = sm
            Case "SECOUND":         s = sm
            Case "AM/PM":           ampm = UCase(Left(sm, 1))
            Case "DAY_OF_YEAR":     doy = sm
            Case "DAY_OF_WEEK":     dow = sm
            Case "WEEK_OF_YEAR":    woy = sm
            Case "NONOSECOUND":     oNanoSecounds = 10 ^ 9 * CDbl("0." & sm)
            Case "QUARTER":         d = 1: m = (sm - 1) * 3 + 1
            Case "QUARTER_END":     d = 0: m = sm * 3 + 1
        End Select
    Next i
 
    'Spezialfälle, welche pestehende 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(y + m + d <> 0, DateSerial(y, m, d), 0) + IIf(h + n + s <> 0, TimeSerial(h, n, s), 0)
 
    Set match = Nothing
 
Exit_Handler:
    Set match = Nothing
    Exit Function
Err_Handler:
    If Not (iParams And tdtIgnoreError) = tdtIgnoreError Then Err.Raise Err.number, Err.source, Err.DESCRIPTION, Err.HelpFile, Err.HelpContext
    strToDate = Null
    Resume Exit_Handler
    Resume
End Function
 
'-------------------------------------------------------------------------------
'--- PRIVATE METHODES
'-------------------------------------------------------------------------------
'/**
' * 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
 
'/**
' * 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 String
 
        Dim frmt As String:         frmt = IIf((iParams And tdtIgnoreCase), UCase(iFormat), iFormat)
        Dim pattern As String:
 
        Dim rxPF As Object
        If Not (iParams And tdtFomat2) = tdtFomat2 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 C_SD_ERR_INVALID_FORMAT, "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 (iParams And tdtExtractDate) = tdtExtractDate Then pattern = "^" & pattern & "$"
        pattern = "/" & pattern & "/" & IIf((iParams And tdtIgnoreCase) = 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 Datumsteil zurück
' * @param  String
' * @param  String
' * return  String
' */
Private Function convertFormatPattern(ByVal iString As String, ByRef oCode As String) As String
    Select Case UCase(iString)
        Case "D":       convertFormatPattern = "(\d{1,2})":     oCode = "DAY"
        Case "DD":      convertFormatPattern = "(\d{2})":       oCode = "DAY"
        Case "M":       convertFormatPattern = "(\d{1,2})":     oCode = "MONTH"
        Case "MM":      convertFormatPattern = "(\d{2})":       oCode = "MONTH"
        Case "YY":      convertFormatPattern = "(\d{2}|\d{4})": oCode = "YEAR"
        Case "YYYY":    convertFormatPattern = "(\d{4})":       oCode = "YEAR"
        Case "H":       convertFormatPattern = "(\d{1,2})":     oCode = "HOUR"
        Case "HH":      convertFormatPattern = "(\d{2})":       oCode = "HOUR"
        Case "N":       convertFormatPattern = "(\d{1,2})":     oCode = "MINUTE"
        Case "NN":      convertFormatPattern = "(\d{2})":       oCode = "MINUTE"
        Case "S":       convertFormatPattern = "(\d{1,2})":     oCode = "SECOUND"
        Case "SS":      convertFormatPattern = "(\d{2})":       oCode = "SECOUND"
        Case "AM/PM":   convertFormatPattern = "(AM|PM)":       oCode = "AM/PM"
        Case "A/P":     convertFormatPattern = "([AP])":        oCode = "AM/PM"
        Case "Y":       convertFormatPattern = "(\d{1,3})":     oCode = "DAY_OF_YEAR"
        Case "W":       convertFormatPattern = "([1234567])":   oCode = "DAY_OF_WEEK"
        Case "WW":      convertFormatPattern = "(\d{1,2})":     oCode = "WEEK_OF_YEAR"
        Case "F":       convertFormatPattern = "(\.?\d{1,9})":  oCode = "NONOSECOUND"
        Case "QQ":      convertFormatPattern = "([1-4])":       oCode = "QUARTER_END"
        Case "Q":       convertFormatPattern = "([1-4])":       oCode = "QUARTER"
    End Select
End Function
 
'-------------------------------------------------------------------------------
'--- 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("/((?=" & C_PATTERN_DELEMITER & "?)(\\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
 
'-------------------------------------------------------------------------------
'--- 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
 
#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