VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "XlsxExporter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-------------------------------------------------------------------------------
'File         : XlsxExporter.cls
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/access/xlsxexporter
'Environment  : VBA 2007+
'Required     : Referenz auf 'MicrosoftExcel XY ObjectLibrary'
'Version      : 2.0.0
'Name         : XlsxExporter
'Author       : Stefan Erb (ERS)
'History      : 27.01.2015 - ERS - Creation
'               28.01.2015 - ERS - Property Get sheet auf Public gewechselt
'               05.02.2015 - ERS - Mächtig erweitert. Viele neue Methoden
'-------------------------------------------------------------------------------

'-------------------------------------------------------------------------------
' Ablauf
' 1) Objekt erstellen
'           Set xExp = XlsxExporter("my_table", "c:\my_path\my_file.xlsx")
' 2) Paramters setzen, falls man das nicht bereits in 1) gemacht hat
'           xExp.paramReadableHeader = true
' 3) Standardformat anpassen
'           xexp.defaultFormat.Font.Size = 10
' 4) Standardformat auf alle vdefinierten Formate anpassen
'           xExp.requeryDefaultFormats
' 5) Dateitypenformate anpassen
'           xExp.format(dbLong).Font.Italic = true
' 6) Weitere Formate definieren
'           xExp.format("MEIN_FORMAT_1").foont.bold = true
' 7) Exportieredie Daten
'           xExp.export
' 8) Formatierungen anweden
'           xExp.doFormatColumnsByType
'           xExp.doFormat "MEIN_FORMAT_1", "C:C"
' 9) Objekt abbauen
'           Set xExp = Nothing
'       oder
'           xExp.quit
'-------------------------------------------------------------------------------
Option Explicit

'-------------------------------------------------------------------------------
' -- Public Members
'-------------------------------------------------------------------------------
Public Enum xeParams
    xeNone = 0                          'Kein Parameter
'Datei-Handler
    xeReplaceExistFile = 2 ^ 0          'Falls die Exportdatei bereits exisitert, kann diese ersetzt werden
'Heder-Settings
    xeCaptionAsHeader = 2 ^ 1           'Es wird versucht die Titel-Eigenschaft des Tabellenfeldes auszulesen
    xeReadableHeader = 2 ^ 2            'Der Technische Name wird möglichst in ein lesbaeren Namen Konvertiert
    xeTechnicalHeader = 2 ^ 3           'Der Technische Name (Feld-Name) wird für den Header verwendet
'Formatierung
    xeRunDefaultFormating = 2 ^ 4       'Nach dem Export wird das Default-Formating angewendet
'WeitereSettings
    xeNotRemoveFormatSheet = 2 ^ 5      'Das Sheet mit den Formatierungen wird am Schluss nicht entfernt
'Standard, wenn nichts angegeben wird
    xeDefaultParams = xeReplaceExistFile + xeTechnicalHeader + xeRunDefaultFormating
End Enum

'-------------------------------------------------------------------------------
' -- Public Members
'-------------------------------------------------------------------------------
Private Const C_FORMAT_SHEET_NAME = "FORMATS"
Private Const C_HEADER_FORMAT_NAME = "HEADER"
Private Const C_DEFAULT_FORMAT_NAME = "DEFAULT"


Private Const C_ERR_CANCELLED = vbObjectError + 1       'Operation cancelled by user
Private Const C_ERR_NOT_DETETD = vbObjectError + 2      'Unable to delete file
Private Const C_ERR_NOT_EXPORTED = vbObjectError + 3
        
Private pFilePath           As String
Private pSource             As String
Private pParams             As xeParams
Private pSpreadSheetType    As AcSpreadSheetType
Private pDataExported       As Boolean
Private pAllreadyQuit       As Boolean

'-------------------------------------------------------------------------------
' -- Private Standards
'-------------------------------------------------------------------------------

'/**
' * Standardformatierung definieren
' * Diese können beliebig geändert werden
' */
Private Sub setDefaultFormats(Optional ByRef iPattern As Variant = C_DEFAULT_FORMAT_NAME, Optional ByVal iOverwrite As Boolean = False)
    Static defFormatsSetted As Boolean
    If defFormatsSetted And Not iOverwrite Then Exit Sub

    'Standardformat
    '-------------------------------------
    'Dieses muss als erstes definiert werden, da es als Grundlage für alle weiteren Definitionen gilt
    If Not formats.exists(C_DEFAULT_FORMAT_NAME) Then defaultFormat.Font.size = 9
    
    'Headerzeile
    '-------------------------------------
    format(C_HEADER_FORMAT_NAME, iPattern, True).Font.Bold = True
    With headerFormat.Interior
        .pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    
    'Typenformate
    '-------------------------------------
    'Datumsfomratierungungen
    format(dbDate, iPattern, True).NumberFormat = "dd.mm.yyyy"
    format(dbTimeStamp, iPattern, True).NumberFormat = "dd.mm.yyyy hh:mm:ss"
    format(dbTime, iPattern, True).NumberFormat = "hh:mm:ss"
    
    
    'Zahlenformatierungen
    format(dbDouble, iPattern, True).NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
    format(dbLong, iPattern, True).NumberFormat = "0"
    format(dbInteger, iPattern, True).NumberFormat = "0"

    'Weitere benannte Formatierungen
    '-------------------------------------
    'Zahlen
    format("FX_RATES", iPattern, True).NumberFormat = "0.00000"
    format("PERCENT", iPattern, True).NumberFormat = "0.00%"

    defFormatsSetted = True
End Sub

'-------------------------------------------------------------------------------
' -- Public Methodes
'-------------------------------------------------------------------------------
'/**
' * Exportiert die Quelle in eine Excel-Datei und gibt eine Instance dieser Klasse zurück
' * @param  String              Quelle
' * @param  String              Export-Pfad
' * @param  AcSpreadSheetType   Excel-Format
' * @param  iParams             Parameters
' */
Public Function instance( _
        Optional ByVal iSource As String, _
        Optional ByVal iFilePath As String, _
        Optional ByVal iSpreadSheetType As AcSpreadSheetType = acSpreadsheetTypeExcel12Xml, _
        Optional ByVal iParams As xeParams = xeDefaultParams _
) As XlsxExporter
Attribute instance.VB_UserMemId = 0
'Attribute instance.VB_UserMemId = 0
    Set instance = New XlsxExporter
    instance.initialize iSource, iFilePath, iSpreadSheetType, iParams
End Function

'/**
' * Initialisiert die Klasse mit allen wichtigen Paramtern
' * @param  String              Quelle
' * @param  String              Export-Pfad
' * @param  AcSpreadSheetType   Excel-Format
' * @param  iParams             Parameters
' */
Public Sub initialize( _
        Optional ByVal iSource As String, _
        Optional ByVal iFilePath As String, _
        Optional ByVal iSpreadSheetType As AcSpreadSheetType = acSpreadsheetTypeExcel12Xml, _
        Optional ByVal iParams As xeParams = xeDefaultParams _
)
    filePath = iFilePath
    source = iSource
    pParams = iParams
    spreadSheetType = iSpreadSheetType
    If paramRunDefaultFormating Then setDefaultFormats
    pAllreadyQuit = False
End Sub

'/**
' * Exportiert die Quelle in eine Excel-Datei und führt ggf das Standardformting aus
' * @param  String              Quelle
' * @param  String              Export-Pfad
' */
Public Sub export( _
        Optional ByVal iSource As String, _
        Optional ByVal iFilePath As String _
)
    If Not iSource = Empty Then source = iSource
    If Not iFilePath = Empty Then filePath = iFilePath
    'in eine temporäre Date exportieren
    DoCmd.TransferSpreadsheet acExport, spreadSheetType, source, tempExportFilePath, hasHeader
    
    'Temporäres Workbook/sheet öffnen
    Dim wbTemp As Excel.Workbook:   Set wbTemp = xlsx.Workbooks.Open(tempExportFilePath)
    Dim wsTemp As Excel.Worksheet:  Set wsTemp = wbTemp.Worksheets(source)
    'Export in das aktuelle Worksheet kopieren
    wsTemp.Copy before:=wsFomats
    dataExported = True
    'Temporäres WOrkbook schliessen/löschen
    wbTemp.Close
    cFso.DeleteFile tempExportFilePath
    
    'Standarddormatierungen durchführen
    'ohne hEaderformatierung. diese wird bei quit() ausgeführt
    If paramRunDefaultFormating Then
        doFormatDefault
        doFormatColumnsByType
    End If
End Sub

'/**
' * gibt die Spaltennummer zu einem Feldnamen zurück
' * @param  String      Spaltenname
' * @return Long        Spaltennummer / Null falls die Spalte nicht gefunden wurde
' */
Public Function getColNrByName(ByVal iFieldName As String) As Long
    If Not dataExported Then Err.Raise C_ERR_NOT_EXPORTED, "XlsxExporter.getColNrByName", "Data not exported. First run export()"
    If index.exists(iFieldName) Then
        getColNrByName = index(iFieldName)
    Else
        getColNrByName = Null
    End If
End Function

'/**
' * Seichert und schliesst die Datei
' * Diese Methode wird beim Abbauen des Objektes ebenfalls ausgeführt
' * @param  Boolean     Flag ob gespeichert werden soll. True = Cancel = Kein Speichern
' */
Public Sub quit( _
        Optional ByVal iCancel As Boolean = False _
)
    If iCancel Or pAllreadyQuit Then GoTo Exit_Handler
    If Not dataExported Then Err.Raise C_ERR_NOT_EXPORTED, "XlsxExporter.quit", "Data not exported. First run export()"
    
     'Datei ersetzen
    If cFso.FileExists(filePath) Then
        If paramReplaceExistFile Then
            cFso.DeleteFile (filePath)
        ElseIf MsgBox("File " & filePath & "allready exists." & vbCrLf & "Replace the File?", vbOKCancel + vbDefaultButton1 + vbQuestion) = vbOK Then
            cFso.DeleteFile (filePath)
        Else
            Err.Raise C_ERR_CANCELLED, "XlsxExporter.export", "Operation cancelled by user"
        End If
        If cFso.FileExists(filePath) Then Err.Raise C_ERR_NOT_DETETD, "XlsxExporter.export", "Unable to delete file " & filePath
    End If
    
    'Header formatieren
    If hasHeader And paramRunDefaultFormating Then doFormatHeader
    'Autofit ausführen (Spaltenbreite anpassen)
    If paramRunDefaultFormating Then autoFit
    'Format-Sheet entfernen
    If Not paramNotRemoveFormatSheet Then
        xlsx.DisplayAlerts = False
        wsFomats.delete
        xlsx.DisplayAlerts = True
    End If
    
    'Datensheet selektionieren und alles speichern
    wsData.Select
    wb.SaveAs filePath

Exit_Handler:
    wb.Close False
    xlsx.quit
    pAllreadyQuit = True
End Sub

'/**
' * Formatiert Ranges
' * @param  Variant     Ein Range/Formatname der als Formatvorlage dient. Meistens ein Range aus format()
' * @param  Variant     Mehrere Ziele. Die folgenden werden akzeptiert
' *                     NUMMER: Spaltennummer
' *                     STRING: Spalte mit dem Feldnamen iTarget oder Excel-Range-String ("A1:B13")
' *                     RANGE:  Der Range wird entsprechend formatiert
' */
Public Sub doFormat( _
    ByRef iFormat As Variant, _
    ParamArray iTargets() As Variant _
)
    If Not dataExported Then Err.Raise C_ERR_NOT_EXPORTED, "XlsxExporter.doFormat", "Data not exported. First run export()"
    If TypeName(iFormat) = "Range" Then
        iFormat.Copy
    Else
        format(iFormat).Copy
    End If
    Dim target As Variant: For Each target In iTargets
        range(target).PasteSpecial xlPasteFormats
    Next
    xlsx.CutCopyMode = False
End Sub

'/**
' * Formatiert das ganze Sheet mit der Standartformatierung
' */
Public Sub doFormatDefault()
    If Not dataExported Then Err.Raise C_ERR_NOT_EXPORTED, "XlsxExporter.doFormatDefault", "Data not exported. First run export()"
    doFormat defaultFormat, wsData.Cells
End Sub

'/**
' * Formatiert die Headerzeile, sofern ein Header vorhanden ist
' * Wird bei paramRunDefaultFormating = true amEnde automatisch ausgeführt
' */
Public Sub doFormatHeader()
    If Not dataExported Then Err.Raise C_ERR_NOT_EXPORTED, "XlsxExporter.doFormatHeader", "Data not exported. First run export()"
    If hasHeader Then
        Dim cell As range: For Each cell In range("1:1").Cells
            If cell.value = Empty Then Exit For
            If paramCaptionAsHeader And Not IsNull(fields.item(cell.Column)("CAPTION")) Then
                cell.value = fields.item(cell.Column)("CAPTION")
            ElseIf pParams And xeReadableHeader Then
                cell.value = readableName(cell.value)
            End If
        Next
        If paramRunDefaultFormating Then doFormat headerFormat, range("A1", wsData.Cells(1, fields.count))
    End If
End Sub

'/**
' * formatiert Spalten anhand der Spaltentypen
' * @param  Variant     Range-Definition. Wenn diese weggelassen wird, werden alleSpalten nach Spaltentypen formatiert
' */
Public Sub doFormatColumnsByType( _
        Optional ByRef iRangeDef As Variant = Null _
)
    If Not dataExported Then Err.Raise C_ERR_NOT_EXPORTED, "XlsxExporter.doFormatColumnsByType", "Data not exported. First run export()"
    
    Dim rng As Excel.range
    If IsNull(iRangeDef) Then
        Set rng = range("A:" & xlsColLetter(fields.count))
    Else
        Set rng = range(iRangeDef)
    End If
    Dim i As Long: For i = rng.Column To (rng.Column + rng.Columns.count - 1)
        Dim type1 As DAO.DataTypeEnum: type1 = fields.item(i)("TYPE")
        If formats.exists(type1) Then doFormat format(type1), fields.item(i)("COL_NR")
    Next i
End Sub

'/**
' passt die Spaltenbreite an. Wird bei paramRunDefaultFormating=true automatisch durchgeführt
' */
Public Sub autoFit()
    wsData.Cells.EntireColumn.autoFit
End Sub


'/**
' * Berechnet die Stanrdformate neu, basierend auf dem defaultFormat
' */
Public Sub requeryDefaultFormats()
    setDefaultFormats C_DEFAULT_FORMAT_NAME, True
End Sub

'-------------------------------------------------------------------------------
' -- Public Properties
'-------------------------------------------------------------------------------

'/**
' * gibt ein Range des DataSheets zurück
' * @param  Variant     Spaltennummer/Spaltenname/Range/Cell2 & Cell2/Excel-Range-String ("A1", "A1:C3" etc)
' * @param  Variant     Spaltennummer/Spaltenname/Range/Cell2 & Cell2/Excel-Range-String ("A1", "A1:C3" etc)
' * @return Range
' */
Public Property Get range( _
    ByRef iRangeDef1 As Variant, _
    Optional ByRef iRangeDef2 As Variant = Null _
) As Excel.range
    If Not dataExported Then Err.Raise C_ERR_NOT_EXPORTED, "XlsxExporter.getRange", "Data not exported. First run export()"
    Dim rng1, rng2 As Excel.range
    
    'Cell2 ermitteln
    If Not IsNull(iRangeDef2) Then Set rng2 = range(iRangeDef2)
    
    Select Case TypeName(iRangeDef1)
        Case "Long", "Integer":     Set range = wsData.Columns(iRangeDef1)
        Case "Range":               Set range = iRangeDef1
        Case "String":
                                    If index.exists(UCase(iRangeDef1)) Then
                                        Set range = wsData.Columns(index(UCase(iRangeDef1)))
                                    Else
                                        Set range = wsData.range(iRangeDef1)
                                    End If
        Case Else:                  Err.Raise 13, "XlsxExporter.getRange()"     '13  Type mismatch
    End Select
    'Falls Cell2 vorhanden ist, range neu definieren
    If Not rng2 Is Nothing Then Set range = wsData.range(range, rng2)
End Property

'/**
' * Quelle
' */
Public Property Get source() As String
    source = pSource
End Property
Public Property Let source(ByVal iSource As String)
    pSource = iSource
    readSourceInformations
End Property
    
'/**
' * Export-Pfad
' */
Public Property Get filePath() As String
    filePath = pFilePath
End Property
Public Property Let filePath(ByVal iFilePath As String)
    pFilePath = iFilePath
End Property

'/**
' * Excel-Format
' */
Public Property Get spreadSheetType() As AcSpreadSheetType
    spreadSheetType = pSpreadSheetType
End Property
Public Property Let spreadSheetType(ByVal iSpreadSheetType As AcSpreadSheetType)
    pSpreadSheetType = iSpreadSheetType
End Property


'/**
' * Flag, ob die Daten bereits exportiert wurden
' */
Public Property Get dataExported() As Boolean
    dataExported = pDataExported
End Property
Private Property Let dataExported(ByVal iExported As Boolean)
    pDataExported = iExported
End Property

'/**
' * Das Worksheet mit den exportierten Daten
' */
Public Property Get wsData() As Excel.Worksheet
    Static ws As Excel.Worksheet
    If Not dataExported Then Err.Raise C_ERR_NOT_EXPORTED, "XlsxExporter.doFormat", "Data not exported. First run export()"
    If ws Is Nothing Then Set ws = wb.Worksheets(source)
    Set wsData = ws
End Property

'/**
' * Das Excelsheet hat eine Headerzeile
' */
Public Property Get hasHeader() As Boolean
    hasHeader = paramCaptionAsHeader Or paramReadableHeader Or paramTechnicalHeader
End Property

'/**
' *  Falls die Exportdatei bereits exisitert, kann diese ersetzt werden
'*/
Public Property Get paramReplaceExistFile() As Boolean
    paramReplaceExistFile = (pParams And xeReplaceExistFile) = xeReplaceExistFile
End Property
Public Property Let paramReplaceExistFile(ByVal iParam As Boolean)
    If Not paramReplaceExistFile = iParam Then pParams = pParams + IIf(iParam, 1, -1) * xeReplaceExistFile
End Property

'/**
' *  Es wird versucht die Titel-Eigenschaft des Tabellenfeldes auszulesen
'*/
Public Property Get paramCaptionAsHeader() As Boolean
    paramCaptionAsHeader = (pParams And xeCaptionAsHeader) = xeCaptionAsHeader
End Property
Public Property Let paramCaptionAsHeader(ByVal iParam As Boolean)
    If Not paramCaptionAsHeader = iParam Then pParams = pParams + IIf(iParam, 1, -1) * xeCaptionAsHeader
End Property

'/**
' *  Der Technische Name wird möglichst in ein lesbaeren Namen Konvertiert
'*/
Public Property Get paramReadableHeader() As Boolean
    paramReadableHeader = (pParams And xeReadableHeader) = xeReadableHeader
End Property
Public Property Let paramReadableHeader(ByVal iParam As Boolean)
    If Not paramReadableHeader = iParam Then pParams = pParams + IIf(iParam, 1, -1) * xeReadableHeader
End Property

'/**
' *  'Der Technische Name (Feld-Name) wird für den Header verwendet
'*/
Public Property Get paramTechnicalHeader() As Boolean
    paramTechnicalHeader = (pParams And xeTechnicalHeader) = xeTechnicalHeader
End Property
Public Property Let paramTechnicalHeader(ByVal iParam As Boolean)
    If Not paramTechnicalHeader = iParam Then pParams = pParams + IIf(iParam, 1, -1) * xeTechnicalHeader
End Property

'/**
' *  Nach dem Export wird das Default-Formating angewendet
'*/
Public Property Get paramRunDefaultFormating() As Boolean
    paramRunDefaultFormating = (pParams And xeRunDefaultFormating) = xeRunDefaultFormating
End Property
Public Property Let paramRunDefaultFormating(ByVal iParam As Boolean)
    If iParam Then setDefaultFormats
    If Not paramRunDefaultFormating = iParam Then pParams = pParams + IIf(iParam, 1, -1) * xeRunDefaultFormating
End Property

'/**
' *  'Das Sheet mit den Formatierungen wird am Schluss nicht entfernt
'*/
Public Property Get paramNotRemoveFormatSheet() As Boolean
    paramNotRemoveFormatSheet = (pParams And xeNotRemoveFormatSheet) = xeNotRemoveFormatSheet
End Property
Public Property Let paramNotRemoveFormatSheet(ByVal iParam As Boolean)
    If Not paramNotRemoveFormatSheet = iParam Then pParams = pParams + IIf(iParam, 1, -1) * xeNotRemoveFormatSheet
End Property

'/**
' * Ein Excel.Range,der als FOrmatvorlage dient
' * @param  Variant     Name oder dao.DataTypeEnum um das Format zu definieren
' * @param  Variant     Format/Range oder FormatName der als Formatvorlage dient
' * @param  Boolean     Bestehende Formateinstellungen verwerfen
' */
Public Property Get format( _
        ByVal iNameOrType As Variant, _
        Optional ByRef iPattern As Variant = C_DEFAULT_FORMAT_NAME, _
        Optional ByVal iOverwrite As Boolean = False _
) As Excel.range
    Dim pattern As Excel.range
    If Not iNameOrType = C_DEFAULT_FORMAT_NAME Then
        Set pattern = IIf(TypeName(iPattern) = "Range", iPattern, format(iPattern))
    End If
    
    If formats.exists(iNameOrType) And iOverwrite Then formats.remove iNameOrType

    If Not formats.exists(iNameOrType) Then
        If IsNumeric(iNameOrType) Then
            formats.add iNameOrType, wsFomats.Cells(1, iNameOrType)
        Else
            formats.add iNameOrType, wsFomats.Cells(2, formats.count + 1)
        End If
        If Not iNameOrType = C_DEFAULT_FORMAT_NAME Then
            pattern.Copy
            formats(iNameOrType).PasteSpecial xlPasteFormats
        End If
    End If
    formats(iNameOrType).value = CStr(iNameOrType)
    Set format = formats(iNameOrType)
End Property

'/**
' * Direktzugirff auf das Standardformat
' */
Public Property Get defaultFormat() As Excel.range
    Set defaultFormat = format(C_DEFAULT_FORMAT_NAME)
End Property

'/**
' * Direktzugirff auf die Headerformatierung
' */
Public Property Get headerFormat() As Excel.range
    Set headerFormat = format(C_HEADER_FORMAT_NAME)
End Property

'-------------------------------------------------------------------------------
' -- Private Methodes
'-------------------------------------------------------------------------------

'/**
' * Erstellt aus einemTechnischen Namen etwas möglichst lesbares
' * @param  String
' * @return String
' */
Private Function readableName(ByVal iTechName As String) As String
    Dim words() As String
    If Not rxWords.Test(iTechName) Then
        ReDim words(0): words(0) = Replace(iTechName, "_", " ")
    Else
        Dim mc As Object: Set mc = rxWords.Execute(iTechName)
        ReDim words(mc.count)
        Dim idx As Integer: For idx = 0 To mc.count - 1
            words(idx) = mc(idx).value
        Next idx
    End If
    readableName = StrConv(Join(words, " "), vbProperCase)
End Function

'/**
' * Gibt den Buchstaben-Key für eine ExcelSpalte anhand einer Spaltennummer aus (Beginnend mit 1)
' *
' * spaltencode = clsColLetter(spaltennummer)
' *
' * @param  Long    Index der Spalte
' * @return String  Spaltenkey
' */
Private Function xlsColLetter(ByVal iColumnNumber As Long) As String
    Const C_ASCII_DELTA = 64
    Dim nr As Long: nr = iColumnNumber
    Do
        Dim rest As Integer: rest = nr Mod 26
        If rest = 0 Then rest = 26
        xlsColLetter = Chr(rest + C_ASCII_DELTA) & xlsColLetter
        nr = Fix((nr - 1) / 26)
    Loop While nr > 0
End Function

'-------------------------------------------------------------------------------
' -- Private Properties
'-------------------------------------------------------------------------------

'/**
' * DieExcel-Instance
' */
Private Property Get xlsx() As Excel.application
    Static pXlsx As Excel.application
    If pXlsx Is Nothing Then Set pXlsx = New Excel.application
    Set xlsx = pXlsx
End Property


'/**
' * Das Workbook mitden Exportierten Daten
' */
Private Property Get wb() As Excel.Workbook
    Static pWb As Excel.Workbook
    If pWb Is Nothing Then Set pWb = xlsx.Workbooks.add
    Set wb = pWb
End Property

'/**
' * Temporäres Sheet um die Formate zu speichern
' * Erste Zeile: Spalte(DAO.DataTypeEnum) beinhaltet das entsprechende Format
' */
Private Property Get wsFomats() As Excel.Worksheet
    Static ws As Excel.Worksheet
On Error GoTo Err_Handler
    If ws Is Nothing Then Set ws = wb.Worksheets(C_FORMAT_SHEET_NAME)

Exit_Handler:
    Set wsFomats = ws
    Exit Property
    
Err_Handler:
    If Err.Number = 9 Then
        Set ws = wb.Worksheets.add(): ws.Name = C_FORMAT_SHEET_NAME
        Resume Exit_Handler
    Else
        Err.Raise Err.Number, Err.source, Err.Description, Err.HelpFile, Err.HelpContext
    End If
End Property


'/**
' * RegExpzur Wörtererkennung
' */
Private Property Get rxWords() As Object
    Static pRx As Object
    If pRx Is Nothing Then Set pRx = cRx("/(?![\s_])(?:[A-Z]?[^A-Z\s_]+)/g")
    Set rxWords = pRx
End Property

'/**
' * Dictionary mit den Feldinformationen
' */
Private Property Get fields(Optional ByVal iRequery As Boolean) As Object
    Static pDict As Object
    If pDict Is Nothing Then Set pDict = CreateObject("scripting.Dictionary")
    Set fields = pDict
End Property

Private Sub readSourceInformations()
    index.RemoveAll
    fields.RemoveAll
    Dim pRs As DAO.Recordset: Set pRs = CurrentDb.OpenRecordset(source)
    Dim fld As DAO.Field: For Each fld In pRs.fields
        Dim colLetter As String: colLetter = xlsColLetter(fld.OrdinalPosition + 1)
        Dim colNr As Long: colNr = fld.OrdinalPosition + 1
        Dim fldDef As Object: Set fldDef = CreateObject("scripting.Dictionary")
        With fldDef
            .add "NAME", fld.Name
            .add "CAPTION", getProperty(fld, "CAPTION")
            .add "COL_NR", colNr
            .add "COL_LETTER", colLetter
            .add "TYPE", fld.Type
        End With
        fields.add colNr, fldDef
        index.add UCase(fld.Name), colNr
    Next
    If fields.exists("TYPE") Then fields.remove ("TYPE")

End Sub

'/**
' * Index der Felder
' * Dictionary(Feldname) = ColNumber
' */
Private Property Get index() As Object
    Static pDict As Object
    If pDict Is Nothing Then Set pDict = CreateObject("scripting.Dictionary")
    Set index = pDict
End Property

'/**
' * Die Formatsammlung
' */
Private Property Get formats() As Object
    Static pDict As Object
    If pDict Is Nothing Then Set pDict = CreateObject("scripting.Dictionary")
    Set formats = pDict
End Property

Private Property Get tempExportFilePath() As String
    Static pPath As String
    If pPath = Empty Then pPath = cFso.BuildPath(cFso.GetParentFolderName(filePath), cFso.GetBaseName(filePath) & "_" & VBA.format(Now, "YYYYMMDD_HHNNSS") & "." & cFso.GetExtensionName(filePath))
    tempExportFilePath = pPath
End Property

'-------------------------------------------------------------------------------
' -- Private Event
'-------------------------------------------------------------------------------
Private Sub Class_Initialize()
        spreadSheetType = acSpreadsheetTypeExcel12Xml
        pParams = xeDefaultParams
End Sub

Private Sub Class_Terminate()
    quit
End Sub

'-------------------------------------------------------------------------------
' -- Private Libraries
'-------------------------------------------------------------------------------

'/**
' * Gibt ein FileSystemObject zurück
' * @return FileSystemObject
' */
Private Property Get cFso() As Object
    Static cachedObj As Object
    If cachedObj Is Nothing Then Set cachedObj = CreateObject("Scripting.FileSystemObject")
    Set cFso = cachedObj
End Property

'/**
' * Dieverse Objekte in Access besitzen Properties. DIese sind aber nicht immer initialisiert
' * Mit dieser Funktion verscuht man ein Property auszulesen. Wenn dies nicht funktioniert, wird ein Default-Wert zurückgegeben
' * @param  Object      Objekt welches das Property beinhalten sollte
' * @param  Name        Eigenschaftsname
' * @param  Variant     Default-Wert, falls die Eigenschaft nicht exisitiert
' * @return Variant
' */
Private Function getProperty(ByRef iObject As Object, ByVal iName As String, Optional ByRef iDefault As Variant = Null) As Variant
    On Error Resume Next
    If IsObject(iObject.properties(iName).value) Then: Set getProperty = iObject.properties(iName).value: Else: getProperty = iObject.properties(iName).value
    If Err.Number <> 0 Then
        If IsObject(iDefault) Then: Set getProperty = iDefault: Else: getProperty = iDefault
    End If
End Function

'/**
' * Dies ist die Minimalversion von cRegExp
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cregexp#abgespeckte_version
' * mögliche Delemiter: @&!/~#=\|
' * mögliche Modifiers: g (Global), i (IgnoreCode, m (Mulitline)
' *
' * @example    myRx = cRx("/([a]{2,})/i") 'Finde alle folgen von a. Flag:IgnoreCase
' * @version    2.1.0 (01.12.2014)
' * @param      String      Pattern mit Delimiter und Modifier analog zu PHP
' * @return     Object      RegExp-Object
' */
Private Function cRx(ByVal iPattern As String) As Object
    Static rxP As Object:       Set cRx = CreateObject("VBScript.RegExp")
    If rxP Is Nothing Then:     Set rxP = CreateObject("VBScript.RegExp"): rxP.pattern = "^([@&!/~#=\|])?(.*)\1(?:([Ii])|([Gg])|([Mm]))*$"
    Dim sm As Object:           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

'Version um in andere Module/Classen einzubauen
Private Sub ref(ByRef oNode As Variant, ByRef iNode As Variant)
    If IsObject(iNode) Then: Set oNode = iNode: Else: oNode = iNode
End Sub