MS Access FrontEnd - ADO Example

[willgerlach]

Hi everyone, here is a small gift to everyone out there who has given
their time to answer questions. This is a real world example that I have
tested. There are still a few bugs, but I hope it helps save some time for
someone. Simply cut and paste and follow the instructions. Note: I am not
a programmer, so asking me technical programming questions is probably be a
waste of time. I am sure there are more efficient ways of doing things
than shown here. Please share any comments or criticisms to this forum for
others to benefit. Enjoy! Good Luck!
Will :-)



###################################################
#################### Form_frmCONSOLE ##################
###################################################
Option Compare Database
Option Explicit
'------------------------------------------------------------------------
'--------------- SETUP INSTRUCTION - MySQL SERVER SIDE --------------
'------------------------------------------------------------------------
'CREATE TABLE -> tblMySQL with "VALUE_ID", "VALUE_Name", "VALUE_TS"
' - 1 Column/field - "VALUE_ID" <- INTEGER, AUTOINCREMENT, NO-UNSIGNED,
' .................................PRIMARY KEY, DEFAULT NULL,
'**** MS Access error 3251 - Current recordset does not support updating...
'probably means that you have "UNSIGNED" this first primary field
' - 2 Column/field - "VALUE_Name" <- VARCHAR(200), DEFAULT NULL
' - 3 Column/field - "VALUE_TS" <- TIMESTAMP, DEFAULT CURRENT_TIMESTAMP
'**** MS AcceSS will fill your Front-end fields with #DELETED if you do not
'setup your the MySQL tables with the CURRENT_TIMESTAMP default in some
'cases. If you use MySQL QueryBrowser setting default to null will automatically
'create a default of current_timestamp.
'Here is a MySQL command-line example of the way to write one:
'EXAMPLE: CREATE TABLE table_name (TS_name NULL DEFAULT......
'.......CURRENT_TIMESTAMP);
'------------------------------------------------------------------------
'-SETUP INSTRUCTION - Microsoft ODBC DATA SOURCES ADMINISTRATOR -
'------------------------------------------------------------------------
'DOWNLOAD AND INSTALL - MyODBC Connector/ODBC 3.51.12
'Make sure to set Option=2 or OPTION=16426 <- MS Access Choices
'(Return matching row + Allow Big Results + Change BIGINT Columns To INT +
'.......Dynamic Cursor)
'**** NOTE: DO NOT SELECT - "Tracing" because there is no odbc3d.dll file as far
'as I can tell for Windows on the internet. I spent a lot of time looking for
'this file described in the manual.
'
'The ODBC ADMINISTRATOR writes the setting to the following:
'---- Windows Registry: HKEY_CURRENT_USER\Software\ODBC\ODBC.INI
'
'------------------------------------------------------------------------
'---------------- SETUP INSTRUCTION - Microsoft Access SIDE -----------
'------------------------------------------------------------------------
'CREATE 1 NEW TABLE - "tblMSA" with "VALUE_ID", "VALUE_Name", "VALUE_TS"
' - 1 Column/field - "VALUE_ID" <- INTEGER, NUMBER, NO-INDEXES, PRIMARY
' .................................DEFAULT NULL (HIDE COLUMN from other users)
' Do not use AUTONUMBER in this case because the script compares "VALUE_ID".
' - 2 Column/field - "VALUE_Name" <- TEXT, DEFAULT NULL
' - 3 Column/field - "VALUE_TS" <- DATE/TIME, DEFAULT NULL
'You can use your "tblMSA" to generate your control object field on your
'forms, just remember to clear the Record Source property afterwards.
'
'CREATE 3 NEW FORMS - "frmCONSOLE", "frmTABLE_LOCAL", "frmTABLE_MySQL"
' - 1st FORM - "frmCONSOLE" - Has 3 buttons with event link to On_Click()
'COPY the text in this file into the code window for the Form_frmCONSOLE
' --- 1- BUTTON - "cmdONLINE_APPEND" linked to itself "frmCONSOLE"
' --- 2- BUTTON - "cmdLOCAL_EDIT" linked to "frmTABLE_LOCAL"
' --- 3- BUTTON - "cmdMySQL_EDIT" linked to "frmTABLE_MySQL"
'NOTE: Make sure to refresh the EVENTS properties of "frmCONSOLE" for
'each botton, by opening the "frmCONSOLE" with the Visual Basic Editor
'------------------------------------------------------------------------
'------------ SETUP INSTRUCTION - Microsoft Visual Basic Editor ---------
'------------------------------------------------------------------------
'*** MS VB Compiler error - User-defined type not defined - Means you need
'to select the reference libraries for VBA:
'- On the menu bar select \TOOLS\REFERENCEs and select the lastest
'..version for the following:
'
'-- Visual Basic For Applications
'-- Microsoft Access xx.x Object Library
'-- OLE Automation
'-- Microsoft ActiveX Data Objects 2.x Library
'-- Microsoft ADO Ext.2.x for DDL and Security
'
'I've included the code for "frmTABLE_MySQL" as shown at bottom. Make sure to

'reset the form's recordset to current event - Form_Open()
'------------------------------------------------------------------------


Private Sub cmdLOCAL_EDIT_Click()
'This is linked to an event button on the frmCONSOLE, which is used to open a
'separate form using the tblMSA table located on the local Machine within a
'MS Access database.

On Error GoTo Err_cmdLOCAL_EDIT_Click

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "frmTABLE_LOCAL"
DoCmd.OpenForm stDocName, acFormDS, , stLinkCriteria

Exit_cmdLOCAL_EDIT_Click:
Exit Sub

Err_cmdLOCAL_EDIT_Click:
MsgBox Err.Description
Resume Exit_cmdLOCAL_EDIT_Click

End Sub

Private Sub cmdMySQL_EDIT_Click()
'This is linked to an event button on the frmCONSOLE, which is used to open a
'separate form using ODBC connection directly to the tblMySQL table located
'on a remote MySQL server.

Dim stDocName As String
Dim stLinkCriteria As String
stDocName = "frmTABLE_MySQL"

On Error GoTo Err_cmdMySQL_EDIT_Click

DoCmd.OpenForm stDocName, acFormDS, , stLinkCriteria

Exit_cmdMySQL_EDIT_Click:
Exit Sub

Err_cmdMySQL_EDIT_Click:
Resume Exit_cmdMySQL_EDIT_Click

End Sub


Private Sub cmdONLINE_APPEND_Click()

Dim catT As New ADOX.Catalog
Dim newTBL As New ADOX.Table
Dim newKey As New ADOX.Key
Dim conI As New ADODB.Connection
Dim conT As New ADODB.Connection
Dim rstI As New ADODB.Recordset
Dim rstT As New ADODB.Recordset
Dim cmd As New ADODB.Command
Dim varFields, varValues As Variant
Dim strSQLc, strSQLi, strSQLt As String
Dim recs As Long
Dim stDocName1 As String
Dim stLinkCriteria As String


'Data source table on MySQL server - "tblMySQL"
strSQLi = "tblMySQL"
'Temporary table to query server results
'against a MS Access database table - "tblTEMP"
strSQLt = "tblTEMP"
'Query String to determine if there are any new records to append
'to the MS Access database table - "tblMSA"
strSQLc = "INSERT INTO tblMSA SELECT tblTEMP.* FROM tblTEMP " & _
"WHERE tblTEMP.VALUE_ID <> ALL (SELECT tblMSA.VALUE_ID FROM tblMSA);"

'Connect catalog container to current project
catT.ActiveConnection = CurrentProject.Connection

'Create Temp Table structure
With newTBL
.Name = strSQLt
'CREATE NO! -- AUTOINCREMENT OR PRIMARY KEY -- Error Duplication of Records
.Columns.Append "VALUE_ID", adInteger
'These commented lines are only shown for example - Do not use!
'.Columns("VALUE_ID").ParentCatalog = catT
'.Columns("VALUE_ID").Properties("AutoIncrement") = True
'Add the primary key
'newKey.Name = "PrimaryKey"
'newKey.Columns.Append "VALUE_ID"
'.Keys.Append newKey, adKeyPrimary
.Columns.Append "VALUE_Name", adWChar
.Columns.Append "VALUE_TS", adDate 'No adDBTimestamp - Support
End With

'Constructed the finished table
On Error GoTo Err_REMOVE_TempTABLE
catT.Tables.Delete strSQLt
Err_AFTER_TempTABLE_REMOVAL:
catT.Tables.Append newTBL

'clear from memory
Set catT = Nothing

'------------------------------------------------------------------------
'- OLE DB - NOT SUPPORTED BY MySQL -> (OLEDB3.DLL)
'- OLEDB3 - their last driver was very problematic?
'- OLE DB PROVIDER is considered obsolete by Microsoft from Carl Prothman
'- CarlProthman.net ---- Beautiful library of connection strings
'------------------------------------------------------------------------
'---------------------- CONNECTION OPTION #1 -------------------------
'--------------ODBC FILEDSN connection using MyODBC Driver ------------
'------ FileDSN files are Stored in a Data Source default directory ---------
'------------------------------------------------------------------------

'conn.ConnectionString = "FILEDSN=C:\Program Files\Common Files\ODBC\Data

'......Sources\YOUR_FILEDSN.DSN;" & _
'"Uid=youruserid;" & _
'"Pwd=yourpassword"

'------------------------------------------------------------------------
'---------------------- CONNECTION OPTION #2 -------------------------
'------------- ODBC DSN connection using MyODBC Driver ----------------
'------------------------------------------------------------------------

'conn.ConnectionString = "DSN=yourODBC"

'******** MS Access Error 7965 ...not valid recordset property. *******
'- MySQL -- NO SUPPORT for CursorLocation = adUseServer -----
'- adUseClient will allow you to set your recordset to the current form


'Populate the temp table with the MySQL records
conI.CursorLocation = adUseClient

'------------------------------------------------------------------------
'---------------------- CONNECTION OPTION #3 -------------------------
'-------------------- OLE DB Provider to ODBC ---------------------------
'------------------------------------------------------------------------
On Error GoTo Err_NO_CONNECTION

conI.Open "Provider=MSDASQL;" & _
"Driver={MySQL ODBC 3.51 Driver};" & _
"Server=localhost -or- 127.0.0.1 -or- server IP address xxx.xxx.xxx.xxx;" & _
"Port=3306 <- default;" & _
"Database=yourDB;" & _
"User=yourUserID;" & _
"Password=yourpassword;" & _
"Option=16426

'---- Fetch the table data from MySQL server & populate tblTEMP ----
'---- adUserClient only supports - adOpenStatic or adOpenForwardOnly --
'---- adOpenKeyset - NOT SUPPORTED BY MySQL ----

'Open new recordset for MySQL record import
rstI.Open strSQLi, conI, adOpenDynamic, adLockOptimistic
'Open local connection to current project
Set conT = CurrentProject.Connection
rstT.Open strSQLt, conT, adOpenDynamic, adLockOptimistic

'Populate --- tblTEMP
Do

varFields = Array("VALUE_ID", "VALUE_Name", "VALUE_TS")
varValues = Array(rstI!VALUE_ID, rstI!VALUE_Name, rstI!VALUE_TS)
rstT.AddNew varFields, varValues
rstT.Update

rstI.MoveNext
Loop Until rstI.EOF

'---- NOTES: Null values and empty recordset or tables ----
'---- True = -1, False = 0 --- No Records = -1 or True.....
'...... but is NOT recognized as NULL
'---- No Records ---- Ingeter [-1] = 0 for RecordsetCount

'Clear memory
rstI.Close
rstT.Close
conI.Close
conT.Close
Set rstI = Nothing
Set rstT = Nothing
Set conI = Nothing
Set conT = Nothing

'Appending the tblMSA table with any new records from the remote server
'based on the VALUE_ID, first creating a connection to the local database.
Set cmd.ActiveConnection = CurrentProject.Connection
cmd.CommandText = strSQLc
cmd.CommandType = adCmdText
cmd.Execute recs, adExecuteNoRecords
MsgBox "Number of new online surveys complete = " & recs
Set cmd = Nothing

'Open the Catalog.
catT.ActiveConnection = CurrentProject.Connection

'Delete the Procedure.
catT.Tables.Delete strSQLt
Set catT = Nothing

'Refresh Form displaying tblMSA table.
Application.Echo False
stDocName1 = "frmTABLE_LOCAL"
DoCmd.Close acForm, stDocName1, acSaveYes
DoCmd.OpenForm stDocName1, acFormDS, , stLinkCriteria
Application.Echo True

'Error coding for broken connections or when the temp table has accidently
'been created.
Err_AFTER_RECONNECTED:
Exit Sub

Err_REMOVE_TempTABLE:
'Delete temp table if for some reason it exits accidentally.
'Continues on after removing stray temp table.
Resume Err_AFTER_TempTABLE_REMOVAL

Err_NO_CONNECTION:
'Either the server was disconnected or connection failed.
MsgBox "You are not currently connected to any server " _
& Chr(13) & Chr(10) & "please either restart the local server or dial-up" _
, vbExclamation, "NO CONNECTION"
Resume Err_AFTER_RECONNECTED


'------------------------------------------------------------------------
'-------------------------- MY CONFIGURATION -------------------------
'------------------------------------------------------------------------
'Windows XP Home SP2
'Access XP (2002) - SP3
'Dial-up 56k
'Remote Server - MySQL - 4.0.24
'Microsoft Jet 4.0 - (msjet40.dll) - 4.0.8618.0
'MDAC 2.8 - SP1
'MyODBC - MySQL ODBC 3.51 Driver - (myodbc3.dll) - 3.51.12.0
'
'------------------------------------------------------------------------
'---------------------------- CONCLUSION ------------------------------
'------------------------------------------------------------------------
'Using code to make connections when you require them eliminates many of the
'connection errors created by Microsoft Access. These failures maybe related to
'the Link Managers being unable to maintain references to the remote data
'sources.
'------------------------------------------------------------------------
'---------------------------- REFERENCES ------------------------------
'------------------------------------------------------------------------
'Reference Manual 4.1 & 5.0 (refman-4.1-en.pdf & refman-5.0-en.a4.pdf)
'Microsoft Jet 4.0 - version 4.0.8618.0
'
'Carl Prothman - Connection Strings
'http://www.carlprothman.net/Default.aspx?tabid=81
'
'MySQL Forums Microsoft Access
'http://forums.mysql.com/list.php?65
'
'MDAC 2.81 SP1
'http://msdn.microsoft.com/data/mdac/downloads/default.aspx
'
'------------------------------------------------------------------------
'------------------------- ERRORS ENCOUNTERED ------------------------
'------------------------------------------------------------------------
'ERROR #1 - Request returned with SQL_ERROR.
'--- This simply means that you have not selected valid ODBC DSN or FILEDSN
'
'MySQL Server- Error 2013 - BUG#8532 (possibly error 2006)
'-- Try using GROUP BY instead of DISTINCT for queries
'-- Try Adding "skip-name-resolve" in the my.cnf or my.ini scripting files
'-- Avoid linked tables to MySQL servers by writing back VBA code
'
'MS Access- Run-time error 3251
'-- Remove "UNSIGNED" from the primary key field on the MySQL-server-side
'-- use adUderClient - MySQL Does not support CursorLocation=adUserServer
'
'MS Access- Error 3151 --connection to '{MySQL ODBC 3.51 Driver}localhost'faild.
'-- Again avoid linked tables to MySQL servers by writing back VBA code
'
'MS Access- Run-time error 3265
'-- Either your recordset query is a non-accessable source such as a local
'table on a remote or there is a request on a field with a different name or
'non-existent table
'
'MS Access- Run-time error 7965
'-- Solution -- There is NO CursorLocation = adUserServer - Use adUserClient
'-- This will prevent setting the recordset to current form.
'
'MS VBA- Compile error- "User-defined type not defined"
'-- Install the VB References Libraries need for the VBA scripts to run
'-- Example: Microsoft ActiveX Data Objects 2.8 Library,
' Microsoft ADO Ext.2.7 for DDL and Security
'
'------------------------------------------------------------------------

End Sub

###################################################
################# Form_frmTABLE_MySQL #################
###################################################
Option Compare Database
Option Explicit

Private Sub Form_Open(Cancel As Integer)
On Error GoTo Err_NO_CONNECTION

Dim con As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strSQL As String
strSQL = "tblMySQL"

con.CursorLocation = adUseClient
con.Open "Provider=MSDASQL;" & _
"Driver={MySQL ODBC 3.51 Driver};" & _
"Server=localhost -or- 127.0.0.1 -or- server IP address xxx.xxx.xxx.xxx;" & _
"Port=3306 <- default;" & _
"Database=yourDB;" & _
"User=yourUserID;" & _
"Password=yourpassword;" & _
"Option=16426

rst.Open strSQL, con, adOpenDynamic, adLockOptimistic
Set Me.Recordset = rst

rst.Close
con.Close
Set rst = Nothing
Set con = Nothing

Err_AFTER_RECONNECTED:

Exit Sub
Err_NO_CONNECTION:
'Either the server was disconnected or connection failed.
MsgBox "You are not currently connected to any server " _
& Chr(13) & Chr(10) & "please either restart the local server or dial-up" _
, vbExclamation, "NO CONNECTION"
DoCmd.Close
Resume Err_AFTER_RECONNECTED

End Sub
###################################################