Function export_mysql()
' Exports the database contents into a file in mysql format
' IS NOT SELECTIVE! (exports ALL tables)
' version 1.00 August 1997
' INSTRUCTIONS
'Paste this function into an Access module of a database which has the
'tables you want to export. Create a macro with the function RunCode and the
'argument export_mysql (). Run the macro to start the export.
Dim dbase As DATABASE, tdef As Recordset, i As Integer, fd As Integer, tname As String, j As Integer, iname As String
Dim s As String, found As Integer, stuff As String, idx As Index, k As Integer, f As Integer, fld As Field, istuff As String
Set dbase = CurrentDb()
'Open the file to export the defintions and data to. Change this to suit your needs ****
Open "c:\temp\mysqldump.txt" For Output As #1
Print #1, "# Converted from MS Access to mysql "
Print #1, "# by Brian Andrews, (c) InforMate (www.informate.co.nz), brian@informate.co.nz, 1997"
Print #1, ""
'Go through the table definitions
For i = 0 To dbase.TableDefs.Count - 1
' Let's take only the visible tables
If ((dbase.TableDefs(i).Attributes And DB_SYSTEMOBJECT) Or (dbase.TableDefs(i).Attributes And DB_HIDDENOBJECT)) Then
Else
' We DROP the table if it already exists
' and then create it again
tname = "" & dbase.TableDefs(i).Name
'remove spaces from tablename
For j = 1 To Len(tname)
If j < Len(tname) Then
If Mid$(tname, j, 1) = " " Then
s = Left$(tname, j - 1)
s = s & "" & Right$(tname, Len(tname) - j)
j = j + 1
found = True
tname = s
End If
End If
Next j
'restrict tablename to 19 chars
tname = Left$(tname, 19)
'comment out these lines if the table doesn't exist or else create it first
Print #1, ""
Print #1, ""
Print #1, "DROP TABLE " & tname & "\g"
Print #1,
Print #1, "CREATE TABLE " & tname & "("
' Step through all the fields in the table
For fd = 0 To dbase.TableDefs(i).Fields.Count - 1
Dim tyyppi As String, pituus As Integer, comma As String
Select Case dbase.TableDefs(i).Fields(fd).Type
Case DB_BOOLEAN
tyyppi = "SMALLINT"
Case DB_INTEGER
tyyppi = "SMALLINT"
Case DB_BYTE
tyyppi = "TINYBLOB"
Case DB_LONG
tyyppi = "INT"
Case DB_DOUBLE
tyyppi = "DOUBLE"
Case DB_SINGLE '
tyyppi = "REAL"
Case DB_CURRENCY
tyyppi = "DOUBLE (8,4)"
Case DB_TEXT
pituus = dbase.TableDefs(i).Fields(fd).Size
tyyppi = "CHAR (" & pituus & ")"
Case dbAutoIncrField
tyyppi = "INT NOT NULL AUTO_INCREMENT"
'Access Date fields are set as the mysql date type - you can change this to
'DATETIME if you prefer.
Case DB_DATE
tyyppi = "DATE"
Case DB_MEMO, DB_LONGBINARY
tyyppi = "BLOB"
End Select
'Print the field definition
'remove spaces from fieldname
stuff = "" & dbase.TableDefs(i).Fields(fd).Name
'we had a table called Index which mysql doesn't like
If stuff = "Index" Then stuff = "Indexm"
For j = 1 To Len(stuff)
If j < Len(stuff) Then
If Mid$(stuff, j, 1) = " " Then
s = Left$(stuff, j - 1)
s = s & "" & Right$(stuff, Len(stuff) - j)
j = j + 1
found = True
stuff = s
End If
End If
Next j
stuff = Left$(stuff, 19)
'not null
If dbase.TableDefs(i).Fields(fd).Required = True Then
tyyppi = tyyppi & " NOT NULL "
End If
'default value
If (Not (IsNull(dbase.TableDefs(i).Fields(fd).DefaultValue)) And dbase.TableDefs(i).Fields(fd).DefaultValue <> "") Then
If dbase.TableDefs(i).Fields(fd).Required = False Then
tyyppi = tyyppi & " NOT NULL "
End If
If Left$(dbase.TableDefs(i).Fields(fd).DefaultValue, 1) = Chr(34) Then
tyyppi = tyyppi & " DEFAULT '" & Mid$(dbase.TableDefs(i).Fields(fd).DefaultValue, 2, Len(dbase.TableDefs(i).Fields(fd).DefaultValue) - 2) & "'"
Else
tyyppi = tyyppi & " DEFAULT " & dbase.TableDefs(i).Fields(fd).DefaultValue
End If
End If
'print out field info
comma = ","
If fd = dbase.TableDefs(i).Fields.Count - 1 Then
If dbase.TableDefs(i).Indexes.Count = 0 Then
comma = ""
Else
comma = ","
End If
End If
Print #1, " " & stuff & " " & tyyppi & comma
Next fd
'primary key and other index declaration
k = 0
For Each idx In dbase.TableDefs(i).Indexes
'Check Primary property
k = k + 1
If idx.PRIMARY Then
istuff = " PRIMARY KEY ("
Else
istuff = " KEY ("
End If
f = 0
For Each fld In idx.Fields
f = f + 1
iname = fld.Name
For j = 1 To Len(iname)
If j < Len(iname) Then
If Mid$(iname, j, 1) = " " Then
s = Left$(iname, j - 1)
s = s & "" & Right$(iname, Len(iname) - j)
j = j + 1
found = True
iname = s
End If
End If
Next j
istuff = istuff & iname
If f < idx.Fields.Count Then
istuff = istuff & ","
End If
Next fld
If k < dbase.TableDefs(i).Indexes.Count Then
Print #1, istuff & "),"
Else
Print #1, istuff & ")"
End If
Next idx
Print #1, ")\g"
Print #1, ""
Dim recset As Recordset
Dim row As String, it As String
Dim is_string As String, reccount As Integer, x As Integer
Set recset = dbase.OpenRecordset(dbase.TableDefs(i).Name)
reccount = recset.RecordCount
If reccount <> 0 Then
' Step through the rows in the table
recset.MoveFirst
Do Until recset.EOF
row = "INSERT INTO " & tname & " VALUES ("
' Go through the fields in the row
For fd = 0 To recset.Fields.Count - 1
is_string = ""
stuff = "" & recset.Fields(fd).Value
Select Case recset.Fields(fd).Type
Case DB_BOOLEAN
'true fields are set to 1, false are set to 0
If recset.Fields(fd).Value = True Then
stuff = "0"
Else
stuff = "1"
End If
Case DB_TEXT, DB_MEMO, 15, DB_LONGBINARY
is_string = "'"
Case DB_DATE
is_string = "'"
'format date fields to YYYY-MM-DD. You may want to add time formatting as
'well if you have declared DATE fields as DATETIME
If stuff <> "" And Not (IsNull(stuff)) Then
stuff = Format(stuff, "YYYY-MM-DD")
End If
Case Else
'default empty number fields to 0 - comment this out if you want
If stuff = "" Then
stuff = "0"
End If
End Select
'**** escape single quotes
x = InStr(stuff, "'")
While x <> 0
s = Left$(stuff, x - 1)
s = s & "\" & Right$(stuff, Len(stuff) - x + 1)
stuff = s
x = InStr(x + 2, stuff, "'")
Wend
'**** convert returns to
's
x = InStr(stuff, Chr(13))
While x <> 0
s = Left$(stuff, x - 1)
s = s & "
" & Right$(stuff, Len(stuff) - x - 1)
stuff = s
x = InStr(x + 2, stuff, Chr(13))
Wend
row = row & is_string & stuff & is_string
If fd < recset.Fields.Count - 1 Then
row = row & ","
End If
Next fd
' Add trailers and print
row = row & ")\g"
Print #1, row
' Move to the next row
recset.MoveNext
Loop
recset.Close
Set recset = Nothing
End If
End If
Next i
Close #1
dbase.Close
Set dbase = Nothing
End Function