Ordner und Dateien verwalten

Public Function RootDatabase() As String

    Dim splitConnectionString() As String
    Dim splitPath() As String
    Dim fullPath As String
    Dim fileName As String
    Dim fileRoot As String

    splitConnectionString = Split(ConnectionString,"""")
    fullPath = splitConnectionString(1)
    splitPath = Split(fullPath,"\")
    fileName = splitPath(UBound(splitPath))
    fileRoot = Left(fullPath,Len(fullPath) - Len(fileName) - 1) ' 1 for \
     
    RootDatabase = fileRoot

End Function

Public RootPath As String
RootPath = RootDatabase()

Public FolderPath As String
FolderPath = RootPath & "\Output Files"

Public Function Table2CSV_Output(VBA_Table As Table, TableName As String, FullFilePath As String, Overwrite As Boolean, ci As Boolean, ri As Boolean, Optional SeparatorTag As String = "", Optional CommentTag As String = "")
' Write table object to csv-file
 
'   VBA_Table       = Table Object
'   TableName       = Section Name e.g. "Resources"
'   FullFilePath    = complete path incl. file name
'   Overwrite       = Overwrite existing data In file(True/False) (Select False To Append)
'   ri, ci          = write row index, column index, true/false
'   SeparatorTag    = Optional, Default ";"
'   CommentTag      = Optional, Default "- - -"    'replace with comment tag given in text
 
    If SeparatorTag = "" Then SeparatorTag = ";"
    If CommentTag = "" Then CommentTag = "- - -"    'replace with comment tag given in text
 
    Dim OutString  As String
    Dim Separator  As String
    Dim fHandle    As Integer
 
    FullFilePath = Trim(FullFilePath)
 
    fHandle = FreeFile
    If Overwrite Then
        FileOpen fHandle, FullFilePath, OpenMode.Output
    Else
        FileOpen fHandle, FullFilePath, OpenMode.Append
    End If
    'Print #fHandle, vbUTF8BOM;              'write file in UTF-8 coding
 
    ' write comment line
    Print fHandle, CommentTag & " Table: " & TableName
 
    Dim row As Long, col As Long    'internal
    Dim rs As Long, cs As Long      'row/column start (0/1) (write first row/first column as table index)
    If ci And VBA_Table.ColumnIndex Then 
        rs = 0      ' Export w column index (row 0)
    ElseIf ci = False And VBA_Table.ColumnIndex = False Then
        rs = 1      ' Export w/o column index (row 0)
    Else
        Stop        ' table does not have a column index
    End If
 
    If ri And VBA_Table.RowIndex Then
        cs = 0
    ElseIf ri = False And VBA_Table.RowIndex = False Then
        cs = 1
    Else
        Stop        ' table does not have a row index
    End If
 
    If VBA_Table.RowCount > 0 Then
        For row = rs To VBA_Table.RowCount
            OutString = ""
            Separator = ""
            For col = cs To VBA_Table.ColumnCount
                OutString = OutString & Separator & VBA_Table(row,col)
                Separator = ";"
            Next
 
            PrintLine fHandle, OutString
 
        Next
    End If
 
    FileClose fHandle
 
End Function

Public Function Table2WorkbookXML_Output(VBA_Table As Table, FullFilePath As String, TableName As String)
    Dim wb As Workbook = New Workbook
    wb.Worksheets.Add TableName

    Dim row As Integer
    Dim col As Integer

    For row = 0 To VBA_Table.RowCount
        For col = 0 To VBA_Table.ColumnCount
            wb.Worksheets(TableName).CellYX(row + 1, col + 1).Value = VBA_Table(row, col)
        Next
    Next

    wb.SaveToFile(FullFilePath)
    
End Function

Public Function DeleteFile(FullFilePath As String)
    If Dir(FullFilePath) <> "" Then
        Kill FullFilePath
    End If
End Function