' importSQL version 1.0
' www.netdive.com/freebies/importsql/
'
' (C) 1998 NetDIVE - www.netdive.com, info@cynergi.net
' (C) Laurent Bossavit - laurent@netdive.com  (do not add to mailing lists without permission)
'
' This code is free for commercial and non-commercial use without permission. However, one
' restriction applies : charging for a service that makes use of this code is OK, but selling
' this code, with or without modifications, is not. You may NOT sell this as part of a non-free
' package. Also, please report any bugs, significant improvements, or helpful comments to
' the author.
'
' ACKNOWLEDGEMENTS
'   To Pedro Freire from Cynergi (http://www.cynergi.net), who created exportSQL, after
'   which importSQL is patterned - down to the format of this documentation. ;)
'
' MODULE
'   "importSQL"
'
' GOAL
'   Import data into an Access database from a MySQL database via ODBC. The
'   MySQL database name used is the title of the Access database, converted
'   to lowercase; for all tables present in the Access database, the records
'   from the table of the same name in MySQL are imported. Tables which do not
'   exist in the MySQL database are left alone; for all others, existing records
'   are DELETEd first. On execution, you will be queried for the host machine
'   where your MySQL server is located.
'
'   Combined with exportSQL, this is extremely handy : you can use Access to
'   design your database, run exportSQL to create a MySQL database, add data
'   to it. If you ever need to change some fields, add tables, etc. just run
'   importSQL to retrieve your data, tweak the database to your heart's content,
'   then use exportSQL again to update the data.
'
' HOW TO USE
'   Copy-and-paste this text file into an Access module and run the first
'   (and only public) function. in more detail, you:
'   * Open the Access .mdb file you wish to synchronize
'   * in the default database objects window, click on "Modules", and then on "New"
'   * The code window that opens has some pre-written text (code). Delete it.
'   * Copy-and-paste this entire file to the code module window
'   * You may hit the compile button (looks like 3 sheets of paper with an arrow on
'     top of them, pressing down on them), or select Debug, Compile Loaded Modules
'     from the top menu, just to make sure there are no errors, and that this code
'     works on your Access version (it works on Access'97 and should work on Access'95)
'   * Close the code module window - windows will prompt you to save the code:
'     answer "Yes", and when promped for a name for the module, type anything
'     (say, "importSQL")
'   The module is now part of your Access database. To run the import, you:
'   * Re-open the code module (by double-clicking on it, or clicking "Design"
'     with it selected). Move the cursor to where the first "Function" keyword appears.
'     Press F5 or select Run, Go/Continue from the top menu.
'   * Alternately, click on "Macros" on the database objects window,
'     and then on "New". On the macro window, select "RunCode" as the macro action,
'     and "importSQL" as the function name, bellow. Save the macro similarly to the
'     module, and this time double-clicking on it, or clicking "Run" will run the import.

Option Compare Database
Option Explicit

Sub importSQL()
On Error GoTo importSQL_error

    Dim Errors As String

    Dim cdb As Database

    Set cdb = CurrentDb()

    Dim ctableix As Integer
    Dim ctabledef As TableDef
    Dim ctablename As String

    Dim cnx As Workspace
    Set cnx = CreateWorkspace("MySQL", "", "", dbUseODBC)

    Dim server As String

    server = InputBox("Server to import from ?")

    'Go through the table definitions
    For ctableix = 0 To cdb.TableDefs.Count - 1

        ' Let's take only the visible tables
        If (((cdb.TableDefs(ctableix).Attributes And DB_SYSTEMOBJECT) Or _
        (cdb.TableDefs(ctableix).Attributes And DB_HIDDENOBJECT))) = 0 Then

            Dim firstField As String

            Set ctabledef = cdb.TableDefs(ctableix)
            ctablename = ctabledef.Name
            firstField = ctabledef.Fields(0).Name

            Dim itsdb As Database
            Dim idx As Integer, dbs As String

            idx = InStr(ctabledef.Connect, "DATABASE=")
            dbs = Mid(ctabledef.Connect, idx + 9)
            Set itsdb = Workspaces(0).OpenDatabase(dbs)
            Dim cnt As Container, doc As Document, tit As String

            Set cnt = itsdb.Containers!Databases
            Set doc = cnt.Documents!SummaryInfo
            tit = doc.Properties!Title
            tit = Format(tit, "<")

            ' This is just to make sure the connection won't pop up many ODBC dialogs
            Dim extdb As Database
            Set extdb = cnx.OpenDatabase("MySQL", dbDriverNoPrompt, False, "ODBC;DSN=MySQL;DATABASE=" + tit + ";USER=;PASSWORD=;PORT=3306;OPTIONS=0;SERVER=" + server + ";")

            Dim rstRemote As Recordset, qryRemote As QueryDef

            On Error Resume Next
            Dim tmpRemote As QueryDef
            Set tmpRemote = cdb.CreateQueryDef("Remote_" + ctablename, "SELECT * FROM " + ctablename)
            Set qryRemote = cdb.QueryDefs("Remote_" + ctablename)
            qryRemote.Connect = "ODBC;DSN=MySQL;DATABASE=" + tit + ";USER=;PASSWORD=;PORT=3306;OPTIONS=0;SERVER=" + server + ";"
            qryRemote.SQL = "SELECT * FROM " + ctablename + " ORDER BY " + firstField

            On Error GoTo recordError

            ' Apparently MySQL's ODBC driver reports zero-length strings as nulls,
            ' which is baaaad. This lets us avoid validation errors due to that
            Dim fldix, fieldCount As Integer
            fieldCount = itsdb.TableDefs(ctablename).Fields.Count
            ReDim notNulls(fieldCount) As Boolean
            For fldix = 0 To fieldCount - 1
                notNulls(fldix) = itsdb.TableDefs(ctablename).Fields(fldix).Required
                itsdb.TableDefs(ctablename).Fields(fldix).Required = False
            Next fldix

            ' Try executing the query once, this will prevent our deleting data in new
            ' tables that are not on the remote database
            qryRemote.OpenRecordset
            ' If the query can be executed, delete current data and import
            cdb.Execute ("DELETE FROM " + ctablename)
            cdb.Execute ("INSERT INTO " + ctablename + " SELECT * FROM Remote_" + ctablename)

recorded:
            On Error GoTo importSQL_error

            qryRemote.Close
            extdb.Close

            cdb.QueryDefs.Delete (qryRemote.Name)

            For fldix = 0 To fieldCount - 1
                itsdb.TableDefs(ctablename).Fields(fldix).Required = notNulls(fldix)
            Next fldix

        End If

    Next ctableix

    If Not (Errors = "") > 0 Then
        MsgBox "There were errors " + Errors
    End If


importSQL_exit:

    cdb.Close
    Set cdb = Nothing

    DoCmd.Hourglass False

    Exit Sub

importSQL_error:
    MsgBox Err.Description
    Resume importSQL_exit

recordError:
    Errors = Errors + " [" + Err.Description + " (" + ctablename + ")]"
    Resume recorded

End Sub