Attribute VB_Name = "Module_DBStructureExporter"
Option Compare Database
Option Explicit

Function GenerateCreateTableStatement(tableName As String) As String
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim idx As DAO.index
    Dim strSQL As String
    Dim strCreate As String
    Dim primaryKey As String
    
    ' Set the current database
    Set db = CurrentDb
    
    ' Check if the table exists
    On Error Resume Next
    Set tdf = db.TableDefs(tableName)
    If Err.Number <> 0 Then
        GenerateCreateTableStatement = "ERROR: Table '" & tableName & "' does not exist!"
        Exit Function
    End If
    On Error GoTo 0
    
    ' Start of the CREATE TABLE statement
    strCreate = "CREATE TABLE [" & tdf.Name & "] (" & vbCrLf
    primaryKey = ""
    
    ' Loop through all fields
    For Each fld In tdf.Fields
        strSQL = "    [" & fld.Name & "] " & GetSQLType(fld)
        
        ' Add default value
        If fld.DefaultValue <> "" Then
            strSQL = strSQL & " DEFAULT " & fld.DefaultValue
        End If
        
        ' Add NOT NULL
        If fld.Required Then
            strSQL = strSQL & " NOT NULL"
        End If
        
        ' Line break
        strCreate = strCreate & strSQL & "," & vbCrLf
    Next fld
    
    ' Determine primary key
    For Each idx In tdf.Indexes
        If idx.Primary Then
            primaryKey = "    PRIMARY KEY ("
            For Each fld In idx.Fields
                primaryKey = primaryKey & "[" & fld.Name & "], "
            Next fld
            primaryKey = Left(primaryKey, Len(primaryKey) - 2) & ")" ' Remove the last comma
        End If
    Next idx
    
    ' If primary key exists, add it
    If primaryKey <> "" Then
        strCreate = strCreate & primaryKey & vbCrLf
    Else
        strCreate = Left(strCreate, Len(strCreate) - 3) & vbCrLf
    End If
    
    strCreate = strCreate & ");" & vbCrLf
    GenerateCreateTableStatement = strCreate
End Function

Function GenerateAllCreateTableStatements() As String
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim result As String
    
    ' Set the current database
    Set db = CurrentDb
    
    ' Loop through all tables
    For Each tdf In db.TableDefs
        ' Ignore system tables and temporary tables
        If Left(tdf.Name, 4) <> "MSys" And Left(tdf.Name, 1) <> "~" Then
            result = result & GenerateCreateTableStatement(tdf.Name) & vbCrLf
        End If
    Next tdf
    
    ' Return the result
    GenerateAllCreateTableStatements = result
End Function

Function GenerateIndexStatements(tableName As String) As String
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim idx As DAO.index
    Dim fld As DAO.Field
    Dim strIndex As String
    Dim result As String
    
    ' Set the current database
    Set db = CurrentDb
    Set tdf = db.TableDefs(tableName)
    
    ' Loop through all indexes
    For Each idx In tdf.Indexes
        If Not idx.Primary Then ' Ignore primary keys
            strIndex = "CREATE INDEX [" & idx.Name & "] ON [" & tableName & "] ("
            For Each fld In idx.Fields
                strIndex = strIndex & "[" & fld.Name & "], "
            Next fld
            strIndex = Left(strIndex, Len(strIndex) - 2) & ");" ' Remove the last comma
            result = result & strIndex & vbCrLf
        End If
    Next idx
    
    GenerateIndexStatements = result
End Function

Function GenerateAllIndexStatements() As String
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim result As String
    
    ' Set the current database
    Set db = CurrentDb
    
    ' Loop through all tables
    For Each tdf In db.TableDefs
        If Left(tdf.Name, 4) <> "MSys" And Left(tdf.Name, 1) <> "~" Then
            result = result & GenerateIndexStatements(tdf.Name) & vbCrLf
        End If
    Next tdf
    
    GenerateAllIndexStatements = result
End Function

Function GenerateForeignKeyStatements(tableName As String) As String
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim rel As DAO.Relation
    Dim fld As DAO.Field
    Dim strForeignKey As String
    Dim result As String
    
    ' Set the current database
    Set db = CurrentDb
    
    ' Loop through all relations
    For Each rel In db.Relations
        If rel.Table = tableName Then
            strForeignKey = "ALTER TABLE [" & tableName & "] ADD CONSTRAINT [" & rel.Name & "] FOREIGN KEY ("
            For Each fld In rel.Fields
                strForeignKey = strForeignKey & "[" & fld.Name & "], "
            Next fld
            strForeignKey = Left(strForeignKey, Len(strForeignKey) - 2) & ") REFERENCES [" & rel.ForeignTable & "] ("
            
            ' Add foreign key fields
            For Each fld In rel.Fields
                strForeignKey = strForeignKey & "[" & fld.ForeignName & "], "
            Next fld
            strForeignKey = Left(strForeignKey, Len(strForeignKey) - 2) & ");"
            
            result = result & strForeignKey & vbCrLf
        End If
    Next rel
    
    GenerateForeignKeyStatements = result
End Function

Function GenerateAllForeignKeyStatements() As String
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim result As String
    
    ' Set the current database
    Set db = CurrentDb
    
    ' Loop through all tables
    For Each tdf In db.TableDefs
        If Left(tdf.Name, 4) <> "MSys" And Left(tdf.Name, 1) <> "~" Then
            result = result & GenerateForeignKeyStatements(tdf.Name) & vbCrLf
        End If
    Next tdf
    
    GenerateAllForeignKeyStatements = result
End Function

Function GetSQLType(fld As DAO.Field) As String
    Select Case fld.Type
        Case dbText
            GetSQLType = "TEXT(" & fld.Size & ")"
        Case dbMemo
            GetSQLType = "TEXT"
        Case dbByte
            GetSQLType = "TINYINT"
        Case dbInteger
            GetSQLType = "SMALLINT"
        Case dbLong
            GetSQLType = "INTEGER"
        Case dbSingle
            GetSQLType = "REAL"
        Case dbDouble
            GetSQLType = "DOUBLE"
        Case dbCurrency
            GetSQLType = "CURRENCY"
        Case dbDate
            GetSQLType = "DATETIME"
        Case dbBoolean
            GetSQLType = "BOOLEAN"
        Case dbGUID
            GetSQLType = "GUID"
        Case Else
            GetSQLType = "UNKNOWN"
    End Select
End Function

Function RemoveEmptyLines(text As String) As String
    Dim lines() As String
    Dim result As String
    Dim i As Integer
    
    ' Split text into lines
    lines = Split(text, vbCrLf)
    
    ' Iterate through all lines
    For i = LBound(lines) To UBound(lines)
        If Trim(lines(i)) <> "" Then ' Add only non-empty lines
            result = result & lines(i) & vbCrLf
        End If
    Next i
    
    ' Return the cleaned text
    RemoveEmptyLines = result
End Function


Function SaveSQLDBStructureToFile(filePath As String)
    Dim fileNum As Integer
    Dim sqlContent As String
    
    ' Delete file if it exists
    If Dir(filePath) <> "" Then
        Kill filePath
    End If
    
    ' Generate all SQL statements
    sqlContent = GenerateAllCreateTableStatements() & vbCrLf & _
                 GenerateAllIndexStatements() & vbCrLf & _
                 GenerateAllForeignKeyStatements()
    
    ' Remove empty lines
    sqlContent = RemoveEmptyLines(sqlContent)
    
    ' Open file (assign number)
    fileNum = FreeFile
    Open filePath For Output As #fileNum
    
    ' Write content
    Print #fileNum, sqlContent
    
    ' Close file
    Close #fileNum
    
    MsgBox "SQL file successfully saved: " & filePath, vbInformation, "Export completed"
End Function