Option Compare Database
Option Explicit

' ===================================================================
' Exporter from Access 97 MDB to MySQL
'
' Made by Moshe Gurvich
' moshe@kabbalah.com
'
' The Kabbalah Centre
' http://www.kabbalah.com
'
' I tried to use existing tools to migrate from MS Access 97 to MySQL,
' but didn't have much success with any of them,
' so I had to create my own thingie.
'
' It's the very first version made overnight so it's still not perfect,
' doesn't transfer references, but overall i got my DB of 70 tables running fine.
'
' I had some problems with importing files record delimited by '\n'
' so i made this weird delimiter (¦) and it was fine.
'
' And, here it is:
'
' Open your MDB file containing the tables with data
' (btw, linked tables can be exported too)
' Create new module,
' Remove the original first 2 lines in the new module
' Copy this code over there
' Save it (Ctrl+S)
'
' Go to database window (F11), open Tools/Analyze/Documenter
' (make sure Advanced Wizards option is installed )
' Choose tables you want to export
' When in the report window, go to File/Save as table
' Open debug window (Ctrl+G), and type
'   MDB2SQL <Destination Folder>[, <Structure Only?>[, <Database Name>]]
'
' If you want only to create structure without transferring actual data, put True after folder
' If your MySQL database already created and you don't want to replace it, skip <Database Name>
' You can't skip <Structure Only?>, if you want to specify <Database Name>, put False or True before it.
'
' Examples:
'   MDB2SQL "c:\temp", True
'   MDB2SQL "c:\temp", False, "MyDB"
'   MDB2SQL "c:\temp"
'
' After the process is done, open mysql.exe and type in:
' mysql> tee 'logfile.log'            # for debugging
' mysql> source c:/temp/import.sql  # put here your export directory before /import.sql
'
' Check the log file if your database was successfully imported.
'
' Enjoy it (would like to get feedback (moshe@kabbalah.com) :)
' ===================================================================

Sub MDB2SQL(DestFolder, optional StructureOnly = False, Optional DBName = "")
    Dim rs, ff
    If Dir(DestFolder, vbDirectory) = "" Then MkDir DestFolder
    
    ff = FreeFile
    Open DestFolder & "\import.sql" For Output As #ff
    
    If DBName <> "" Then
        Print #ff, "DROP DATABASE " & DBName & ";"
        Print #ff, "CREATE DATABASE " & DBName & ";"
        Print #ff, "USE " & DBName & ";"
    End If
    
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM [Object Definition] WHERE [Object Type]='Table'")
    Do Until rs.EOF
        if not StructureOnly then Table2TXT rs!Name, DestFolder & "\" & rs!Name & ".txt"
        
        Print #ff, "select '" & rs!Name & "';"
        Print #ff, CreateTable(rs!ID, rs!Name)
        if not StructureOnly then 
			Print #ff, "load data infile '" & DestFolder & "/" & rs!Name & ".txt' into table " & rs!Name & _
				" fields terminated by ',' enclosed by '\""' escaped by '\\' lines terminated by '¦';" & vbCrLf
		end if
        rs.MoveNext
    Loop
    rs.Close
    Close #ff
End Sub


Function GetTables()
    Dim s, s1, rs
    s = ""
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM [Object Definition] WHERE [Object Type]='Table'")
    Do Until rs.EOF
        s1 = GetColumns(rs!ID) & vbCrLf
        If Right(s1, 3) = "," & vbCrLf Then s1 = Left(s1, Len(s1) - 3) & vbCrLf
        s = s & "CREATE TABLE if not exists " & rs!Name & " (" & vbCrLf & s1 & ");" & vbCrLf & vbCrLf
        Debug.Print rs!Name & ", ";
        rs.MoveNext
    Loop
    Debug.Print
    rs.Close
    GetTables = s
End Function


Function CreateTable(TableID, TableName)
    Dim s1
    SysCmd acSysCmdSetStatus, "Creating " & TableName & "..."
    s1 = GetColumns(TableID) & vbCrLf
    If Right(s1, 3) = "," & vbCrLf Then s1 = Left(s1, Len(s1) - 3) & vbCrLf
    CreateTable = "CREATE TABLE if not exists " & TableName & " (" & vbCrLf & s1 & ");" & vbCrLf & vbCrLf
    SysCmd acSysCmdClearStatus
End Function


Function GetColumns(TableID)
    Dim s, s1, rs, a1, a2, s2
    s = ""
    s1 = GetIndexes(TableID)
    s2 = "": a1 = InStr(s1, "PRIMARY KEY ("): If a1 > 0 Then a1 = a1 + 13: a2 = InStr(a1, s1, ")"): s2 = LCase(Mid(s1, a1, a2 - a1))
    
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM [Object Definition] WHERE ParentID=" & TableID & " AND [Object Type]='Column'")
    Do Until rs.EOF
        s = s & "    " & Trim(JStr(rs!Name, 20, 1) & " " & GetColumnProperties(rs!ID, rs!Extra2, rs!Extra3, InStr(s2, LCase(rs!Name)))) & vbCrLf
        rs.MoveNext
    Loop
    rs.Close
    s = s & vbCrLf
    If s1 <> "" Then s = s & Left(s1, Len(s1) - 3)
    GetColumns = s
End Function


Function GetColumnProperties(ColumnID, ColumnName, ColumnLen, isPrimaryKey)
    Dim t, s, c, rs, a1
    t = ConvertType(ColumnName, ColumnLen)
    s = ""
    c = ""
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM [Object Definition] WHERE ParentID=" & ColumnID & " AND [Object Type]='Property'")
    Do Until rs.EOF
        Select Case rs!Name
        Case "Default Value: "
            If rs!Extra1 = "Now()" Or rs!Extra1 = "Now" Then
                t = "TIMESTAMP"
            Else
                s = s & " DEFAULT " & Switch(rs!Extra1 = "Yes", -1, rs!Extra1 = "No", 0, True, rs!Extra1)
            End If
            
        Case "Primary: "
            If rs!Extra1 = "True" Then s = s & " PRIMARY KEY"
        
        Case "Attributes: "
            If InStr(rs!Extra1, "Auto-Increment") > 0 Then s = s & " AUTO_INCREMENT"
        
        Case "Description: "
            c = c & "; " & rs!Name & rs!Extra1
        End Select
        rs.MoveNext
    Loop
    rs.Close
    If isPrimaryKey Then s = s & " NOT NULL"
    GetColumnProperties = t & JStr(s & ", ", 25, 0) & IIf(c <> "", "# " & Mid(c, 3), "")
End Function


Function GetIndexes(TableID)
    Dim s, rs
    s = ""
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM [Object Definition] WHERE ParentID=" & TableID & " AND [Object Type]='Index'")
    Do Until rs.EOF
        If Left(rs!Name, 1) <> "{" Then
            s = s & Space(4) & GetIndexProperties(rs!ID, rs!Name) & GetIndexFields(rs!ID) & "," & vbCrLf
        End If
        rs.MoveNext
    Loop
    rs.Close
    GetIndexes = s
End Function


Function GetIndexProperties(IndexID, IndexName)
    Dim s, rs
    s = "INDEX " & IndexName
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM [Object Definition] WHERE ParentID=" & IndexID & " AND [Object Type]='Property' And Extra1='True'")
    Do Until rs.EOF
        Select Case rs!Name
        Case "Primary: ": s = "PRIMARY KEY"
        Case "Unique: "
            s = "UNIQUE " & IndexName
        End Select
        rs.MoveNext
    Loop
    rs.Close
    GetIndexProperties = s
End Function


Function GetIndexFields(IndexID)
    Dim s, rs
    s = ""
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM [Object Definition] WHERE ParentID=" & IndexID & " AND [Object Type]='Index Field'")
    Do Until rs.EOF
        s = s & ", " & rs!Name
        rs.MoveNext
    Loop
    rs.Close
    GetIndexFields = " ( " & Mid(s, 3) & " )"
End Function


Function JStr(s, w, a)
    Dim sp
    sp = w - Len(s): If sp < 0 Then sp = 0
    Select Case a
        Case 0: JStr = s & Space(sp)
        Case 1: JStr = Left(s, w) & Space(sp)
        Case 3: JStr = Space(sp) & Left(s, w)
    End Select
End Function


Function ConvertType(src, ln)
    Select Case src
    Case "Currency": ConvertType = "FLOAT(10,2)"
    Case "Date/Time": ConvertType = "DATETIME"
    Case "Memo": ConvertType = "TEXT"
    Case "Number (Integer)": ConvertType = "SMALLINT"
    Case "Number (Long)": ConvertType = "INT"
    Case "Number (Single)": ConvertType = "FLOAT"
    Case "Text": ConvertType = "CHAR(" & ln & ")"
    Case "Yes/No": ConvertType = "TINYINT"
    End Select
End Function


Function Table2TXT(TName, FName)
    Dim s, rs, fld, ff, i, j
    ff = FreeFile
    s = ""
    i = 0
    Set rs = CurrentDb.OpenRecordset(TName)
    If rs.EOF Then rs.Close: Exit Function
    rs.MoveLast
    SysCmd acSysCmdInitMeter, "Exporting " & TName & "...", rs.RecordCount
    rs.MoveFirst
    Open FName For Output As #ff
    Do Until rs.EOF
        j = 0
        For Each fld In rs.Fields
            j = j + 1
            If j > 1 Then s = s & ","
            Select Case fld.Type
            Case dbDate, dbTime, dbTimeStamp
                If Not IsNull(rs(fld.Name)) Then s = s & """" & Format(rs(fld.Name), "yyyy-mm-dd hh:nn:ss") & """"
            Case dbChar, dbMemo, dbText
                If Nz(rs(fld.Name), "") <> "" Then s = s & """" & replace(replace(rs(fld.Name), """", "\"""), vbCrLf, "\n") & """"
            Case dbBoolean
                s = s & IIf(rs(fld.Name), -1, 0)
            Case Else
                s = s & rs(fld.Name)
            End Select
        Next
        s = s & "¦"
        i = i + 1
        If Len(s) > 10000 Then
            SysCmd acSysCmdUpdateMeter, i
            DoEvents
            Print #ff, s;
            s = ""
        End If
        rs.MoveNext
    Loop
    Print #ff, s;
    Close #ff
    rs.Close
    SysCmd acSysCmdRemoveMeter
End Function


Function Replace(a, b, c)
    Dim i
    i = InStr(a, b)
    Do Until i = 0
        a = Left(a, i - 1) & c & Mid(a, i + Len(b))
        i = InStr(i + Len(c), a, b)
    Loop
    replace = a
End Function