|
MySQL.RU - Webboard
 Вернуться
 Для всех. MS Access -> MySQL (..JoZh..) 12/02/2003 - 20:22:31
From: ..JoZh.. - 12/02/2003 - 20:22:31
Subject:Для всех. MS Access -> MySQL
-----------------
Похоже - это наиболее задаваемый вопрос форума.
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
[Это сообщение - спам!]
Последние сообщения из форума
Уважаемые посетители форума MySQL.RU!
Убедительная просьба, прежде чем задавать свой вопрос в этом форуме, обратите внимание на разделы:
- ответы на наиболее часто задаваемые вопросы - FAQ
- раздел документация
- раздел поиск по сообщениям форума и документации
Также, старайтесь наиболее подробно указывать свою ситуацию (версию операционной системы, версию MySQL,
версию программного обеспечения, по которому возникает вопрос, текст возникающих ошибок, и др.)
Помните, чем конкретнее Вы опишете ситуацию, тем больше шансов получить реальную помощь.
6691
|
|
