[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 368
  • Last Modified:

Still looking for a solution to Automatic Linking of MYSql table from within Access - ref# Q_21787804.html

I am trying to find the right approach to refreshing Linked tables that are from a MYSql backend from with Access/VBA. I have seen code to refresh SQL and Access tables and when I try to converrt this code to use a MY Sql table I am unsuccessful.

All I want to do is on open of my database it refreshes all linked tables and not just the Access tables, I have gotten the error 91 in some cases.

I want to be able to use a scheduling program to run my daily reports during the night and this problem is preventing me from accomplishing this task. There must be a simple bit of code that will accomplish this task.

I have searched the internet high and low with out success.  I have tried the MYODBC connection string, I have looked at Microsoft website - the code there is for SQL and not MYSql.

Any an all suggestions are greatly appreciated.  I am under a deadline and would like to tell my client I have found the solution.  If it was possible I would double the awarded points to the person who has a workable solution.

Thanks,
Karen
0
Karen Schaefer
Asked:
Karen Schaefer
  • 6
  • 4
  • 3
  • +1
1 Solution
 
Rey Obrero (Capricorn1)Commented:
0
 
Karen SchaeferAuthor Commented:
Thanks you for the suggestion, however, I already have the DSN odbc connection setup - the problem is that on open of the database I have to manually relink the table using the Linked Table manager in Acccess.  I want to eliminate this step be using some VBA code to refresh the established link.

Any other ideas.

Thanks,

Karen
0
 
BPebCommented:
I have a code module in all of my Access apps that checks the links and if not found it prompts the user to locate the new location.  It uses the various collections available in Access and one 'cheat' table to hold the curent names of all tables, their database (mdb) and locations (path).  The table allows the code to find related missing tables and link them all back in as a batch operation instead of having the user find 'em one at a time.  I don't know if it will work wil MYSQL DB's, but it might (straight out or with minor mods).   Here's the main parts of the code (let me know if you want it all):
==========================
Public Function CheckLinks() As Boolean
On Error GoTo CheckLinks_Err
Dim DB As DAO.Database, QD As DAO.QueryDef, RS As DAO.Recordset
Dim RSPath As DAO.Recordset
Dim objCat As New ADOX.Catalog, objTbl As ADOX.Table
Dim objTbl2Fix As ADOX.Table
Dim FileName As String, FullSpec As String, Tries As Integer
Dim FullPath As String, Drive As String, Folder As String
Dim Extension As String, TableIn As String
Dim IsMapi As Boolean, IsImex As Boolean, IsTemp As Boolean
Dim FailedLink As Boolean, StrMsg As String

Const strImex = "IMEX"
Const strMapi = "MAPILEVEL="

    CheckLinks = False
    Set DB = CurrentDb
    Set QD = DB.QueryDefs("qryConnect_All")
    Set RS = QD.OpenRecordset()
    Set QD = Nothing
    If Not (RS.EOF And RS.BOF) Then
        objCat.ActiveConnection = CurrentProject.Connection
        Do
            Tries = 0
ReTry:
            Tries = Tries + 1
            TableIn = Trim$(RS![TblName])
            Set objTbl = objCat.Tables(TableIn)
            FullSpec = objTbl.Properties("Jet OLEDB:Link Datasource")
            FileName = Mid(FullSpec, InStrRev(FullSpec, "\", Len(FullSpec)) + 1, Len(FullSpec))
            If Tries <= 2 Then
                If DoesFileExist(FullSpec) Then
                     objTbl.Properties("Jet OLEDB:Link Datasource") = FullSpec
                Else
                    StrMsg = "Missing: " & FileName & " please find the new location"
                    If CmdlgFileOpen(FullSpec, cdlOFNExplorer Or cdlOFNFileMustExist Or cdlOFNHideReadOnly, "Microsoft Access (*.mdb)|*.mdb", , , FileName, StrMsg, FullSpec) Then
                        SplitPath FullSpec, Drive, Folder, FileName, Extension
                        Set QD = DB.QueryDefs("qrypConnect_UpdatePaths")
                        QD.Parameters("DBName") = FileName & Extension
                        QD.Parameters("Path") = Drive & Folder
                        QD.Execute
                        Set QD = DB.QueryDefs("qrypConnect_GetDBPathInfo")
                        QD.Parameters("DBName") = FileName & Extension
                        Set RSPath = QD.OpenRecordset()
                        Set QD = Nothing
                        If Not (RSPath.EOF And RSPath.BOF) Then
                            Do
                            TableIn = Trim$(RSPath![TblName])
                            Set objTbl2Fix = objCat.Tables(TableIn)
                            objTbl2Fix.Properties("Jet OLEDB:Link Datasource") = Drive & Folder & FileName & Extension
                            RSPath.MoveNext
                            Loop Until RSPath.EOF
                        End If
                        objCat.Tables.Refresh
                        GoTo ReTry
                    End If
                End If
            End If
            RS.MoveNext
        Loop Until RS.EOF
    End If
    CheckLinks = True

CheckLinks_Exit:
    Exit Function

CheckLinks_Err:
    MsgBox Err.Description & " " & Err.Number
    Resume CheckLinks_Exit

End Function


Public Function ResetLinks() As Boolean
'Use to switch between Test and Prod
On Error GoTo ResetLinks_Err
Dim DB As DAO.Database, QD As DAO.QueryDef, RS As DAO.Recordset
Dim RSPath As DAO.Recordset
Dim objCat As New ADOX.Catalog, objTbl As ADOX.Table
Dim objTbl2Fix As ADOX.Table
Dim FileName As String, FullSpec As String, Tries As Integer
Dim FullPath As String, Drive As String, Folder As String
Dim Extension As String, TableIn As String
Dim IsMapi As Boolean, IsImex As Boolean, IsTemp As Boolean
Dim FailedLink As Boolean, StrMsg As String

Const strImex = "IMEX"
Const strMapi = "MAPILEVEL="

    ResetLinks = False
    Set DB = CurrentDb
    Set QD = DB.QueryDefs("qryConnect_Reset")
    Set RS = QD.OpenRecordset()
    Set QD = Nothing
    If Not (RS.EOF And RS.BOF) Then
        Do
        TableIn = Trim$(RS![FirstTable])
            objCat.ActiveConnection = CurrentProject.Connection
            Set objTbl = objCat.Tables(TableIn)
            FullSpec = objTbl.Properties("Jet OLEDB:Link Datasource")
            FileName = Mid(FullSpec, InStrRev(FullSpec, "\", Len(FullSpec)) + 1, Len(FullSpec))
            StrMsg = "Where is " & FileName & " located?"
            If CmdlgFileOpen(FullSpec, cdlOFNExplorer Or cdlOFNFileMustExist Or cdlOFNHideReadOnly, "Microsoft Access (*.mdb)|*.mdb", , , FileName, StrMsg, FullSpec) Then
                SplitPath FullSpec, Drive, Folder, FileName, Extension
                Set QD = DB.QueryDefs("qrypConnect_UpdatePaths")
                QD.Parameters("DBName") = FileName & Extension
                QD.Parameters("Path") = Drive & Folder
                QD.Execute
                Set QD = DB.QueryDefs("qrypConnect_GetDBPathInfo")
                QD.Parameters("DBName") = FileName & Extension
                Set RSPath = QD.OpenRecordset()
                Set QD = Nothing
                If Not (RSPath.EOF And RSPath.BOF) Then
                    Do
                        TableIn = Trim$(RSPath![TblName])
                        Set objTbl2Fix = objCat.Tables(TableIn)
                        objTbl2Fix.Properties("Jet OLEDB:Link Datasource") = Drive & Folder & FileName & Extension
                        RSPath.MoveNext
                    Loop Until RSPath.EOF
                End If
                objCat.Tables.Refresh
            End If
            RS.MoveNext
        Loop Until RS.EOF
    End If
    ResetLinks = True

ResetLinks_Exit:
    Exit Function

ResetLinks_Err:
    MsgBox Err.Description & " " & Err.Number
    Resume ResetLinks_Exit

End Function
==========================



0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
Karen SchaeferAuthor Commented:
Thanks for the suggestion, however, I get an error on objCat As New ADOX.Catalog, when I try to compile the module.  Which reference do I need to add in order to use the ADOX.catalog?

K
0
 
Karen SchaeferAuthor Commented:
Found the reference , now I get an error looking for "DoesFileExist".  am I missing something?
k
0
 
Karen SchaeferAuthor Commented:
also missing code for the "CmdlgFileOpen"
0
 
BPebCommented:
Oh I'm sorry if I wasn't clear.  I only pasted the two main functions to let you look at them to see if you thought they'd work for you.  If you want I'll send the rest and instructions for tomorrow.

It would be a lot of work to try and figure out what's what, so if it's ok with you I'll send you the mdb zipped since that's easiest way to try the code out.

To answer your questions though. Yes you do need a reference to the ADO Ext for DDL and Security.   DoesFileExist is another function I wrote and CmdlgFileOpen is a custom class the handles the file open dialog box.

Craig
0
 
infolurkCommented:
Have you tried putting a connection string in a module called by your autoexec macro?

Something like;
Public Function MySql_Initialization()

Dim myDB As DAO.Database
Dim strConnect As String
   
On Error GoTo NoConn

Set myDB = CurrentDb()
strConnect = "Provider=MySQLProv;Data Source=Your_MySQL_Database;User Id=Your_Username; Password=Your_Password;"
Set myDB = OpenDatabase("", False, False, strConnect)
myDB.Close
Exit Function

NoConn:
MsgBox "You cannot connect to MySql, contact your system administrator !"
   
End Function
 
0
 
BPebCommented:
I have the mdb zipped and ready to send, but to follow EE rules I need to post it to a free site and provide a link here.  

Don't have a website set up, so does anybody know where I should post this so it can be used by all?
0
 
Karen SchaeferAuthor Commented:
Thanks infolurk for the solution - however, I am still getting either a error 3151 or a popup window for MYSQL ODBC Connection to click oK on.   Unfortunately this does not solve my problem of automating the ODBC connections.  when I run the your code as is I get the pop up do I need to add the MYSql MyODBC coonection string?

Here is my current code with my attempted to pass the correct values commented out.

Please advise how I should proceed.

Karen

Public Function MySql_Initialization()

Dim myDB As DAO.Database
Dim strConnect As String
   
On Error GoTo NoConn

Set myDB = CurrentDb()
'strConnect = "DRIVER={MySQL ODBC 3.51 Driver};" & _
                       " SERVER=localhost;" & _
                       " DATABASE=DataMart;" & _
                       " UID=username;PWD=password; OPTION=35"
strConnect = "Provider=MySQLProv;Data Source=Your_MySQL_Database;User Id=kschaefer; Password=******;"
Set myDB = OpenDatabase("MySql_Datamart", False, False, strConnect)
myDB.Close
Exit Function

NoConn:
MsgBox "You cannot connect to MySql, contact your system administrator !"
   
End Function
0
 
infolurkCommented:
Hi Karen,
Your driver information should be specified in your DSN.
Try;
Public Function MySql_Initialization()
Dim myDB As DAO.Database
Dim strConnect As String
On Error GoTo NoConn
Set myDB = CurrentDb()
strConnect = "ODBC;UID=kschaefer;PWD=******;DSN=DSN of database you want to connect to;Database=DataMart"
Set myDB = OpenDatabase("", False, False, strConnect)
myDB.Close
Exit Function
NoConn:
MsgBox "You cannot connect to MySql, contact your system administrator !"
End Function
0
 
Karen SchaeferAuthor Commented:
This current code has the DSN ODBC window opening and asking the the DSN name - is there a way to eliminate this step to make it totally automated?

Karen
0
 
infolurkCommented:
And if you give it the DSN it works? If so,
Try;
Public Function MySql_Initialization()
Dim myDB As DAO.Database
Dim strConnect As String
On Error GoTo NoConn
Set myDB = CurrentDb()
strConnect = "DSN=DSN of database you want to connect to;UID=kschaefer;PWD=******;"
Set myDB = OpenDatabase("", False, False, strConnect)
myDB.Close
Exit Function
NoConn:
MsgBox "You cannot connect to MySql, contact your system administrator !"
End Function
0
 
BPebCommented:
Here's the link to the zipped file: http://www.webfilehost.com/?mode=viewupload&id=9506833
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 6
  • 4
  • 3
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now