Option Explicit
Public dbname As String
Public fldnames(100, 2) As String
Public conn As ADODB.Connection
Public sh As Worksheet
'
' EXAMPLE VBA CODE: Use SQL statement to copy data from NWind.mdb
'
' Single, simple function to copy data from mdb to the spreadsheet
Public Sub readNWind()
Dim db As Database, rs As Recordset
Set db = OpenDatabase("NWind.mdb")
Set rs = db.OpenRecordset("SELECT Categories.CategoryID, Categories.CategoryName, " & _
"Categories.Description, `Category Sales for 1995`.CategorySales " & _
"FROM Categories Categories, `Category Sales for 1995` `Category Sales for 1995` " & _
"WHERE `Category Sales for 1995`.CategoryName = Categories.CategoryName")
ThisWorkbook.Worksheets("Sheet1").Range("A1").CopyFromRecordset rs
End Sub
'=======================================================================
' 3 ROUTINES TO COPY TABLES FROM NWind.mdb to MySQL
'=======================================================================
'
' First routine: list table names in NWind.mdb, create if missing from MySQL,
' then copy data
'
Public Sub listDbFields()
Dim db As Database, rs As Recordset, tdf As TableDef, fld As Field
Dim SQL As String, nm As String
Dim msqltyp As String, r As Integer, c As Integer, sh As Worksheet
openMySQLConn
'Set sh = ThisWorkbook.Worksheets("MySQLExamples")
'sh.UsedRange.Clear
Set db = OpenDatabase("Nwind.mdb")
r = 1
For Each tdf In db.TableDefs
If Left(tdf.Name, 4) <> "MSys" Then
SQL = "CREATE TABLE if not exists `" & tdf.Name & "`(" & vbCrLf & _
"ID integer PRIMARY KEY auto_increment," & vbCrLf
'sh.Cells(r, 1) = tdf.Name
c = 1
' The outside loop (above) takes the name of each of the Access tables.
' Using this tabledef, it loops through the individual fields
' below and builds a SQL statement to create the table in the
' MySQL database of choice. After adding the table to the database
' it loops through the records, creating INSERT statements which
' it then executes
For Each fld In tdf.Fields
' Ascertain the type (simplifying: can be changed later)
Select Case fld.Type
Case Is = dbInteger, dbBigInt, dbLong
msqltyp = "integer"
Case Is = dbFloat, dbDouble, dbSingle
msqltyp = "double"
Case Is = dbCurrency, dbNumeric
msqltyp = "decimal"
Case Is = dbText, dbChar, dbByte
msqltyp = "text"
Case Is = dbDate, dbTime
msqltyp = "datetime"
Case Is = dbVarBinary, dbLongBinary, dbBinary, dbMemo, dbGUID
msqltyp = "blob"
Case Is = dbBoolean
msqltyp = "boolean"
Case Else
msqltyp = "(unident)"
End Select
' Create the field name/type in the CREATE statement
fldnames(c, 1) = fld.Name: fldnames(c, 2) = msqltyp
SQL = SQL & fld.Name & " " & msqltyp
If c < tdf.Fields.Count Then SQL = SQL & "," & vbCrLf
c = c + 1
Next
SQL = SQL & ")"
nm = "`" & tdf.Name & "`"
addMysqlTable nm, SQL ' Create table in MySQL
copyData db, nm ' Copy the data
End If
Next
End Sub
'
' Check to see if table exists, if it does drop it, then create it
'
Public Sub addMysqlTable(tbl As String, SQL As String)
conn.Execute "DROP TABLE IF EXISTS " & tbl
Debug.Print tbl & " created"
conn.Execute SQL
End Sub
'
' Copy data from database (mdb) to mysql
'
Public Sub copyData(db As Database, tblname As String) ' conn is set for table
Dim rs As Recordset, fld As Field, comma As String, vals As String
Dim v As Variant
Dim SQL As String, i As Integer
Set rs = db.OpenRecordset("SELECT * FROM " & tblname)
rs.MoveFirst
While Not rs.EOF
SQL = "INSERT INTO " & tblname & "("
vals = ""
For i = 1 To rs.Fields.Count
comma = ","
If fldnames(i, 2) <> "blob" Then
SQL = SQL & fldnames(i, 1) & comma
If fldnames(i, 2) = "text" Then
vals = vals & Chr(34) & rs.Fields(i - 1).Value & Chr(34) & comma
Else
v = rs.Fields(i - 1).Value
If v = "" Then v = 0
vals = vals & v & comma
End If
End If
Next i
SQL = Left(SQL, Len(SQL) - 1) & ")" & " Values (" & Left(vals, Len(vals) - 1) & ")"
'Debug.Print SQL
On Error GoTo badrcd
conn.Execute (SQL)
rs.MoveNext
Wend
Exit Sub
badrcd:
On Error GoTo 0
Debug.Print "Ignoring " & SQL
Resume Next
End Sub
Public Sub openMySQLConn()
Dim SQL As String
Set conn = New ADODB.Connection
conn.ConnectionString = "DRIVER={MySQL ODBC 5.1 Driver};" _
& " SERVER=[insert your server name here]; port=3307;" _
& " DATABASE=[insert database name];" _
& " UID=guest;PWD=[insert password];OPTION=3"
conn.Open
End Sub