How to refresh linked tables if Access disconnects from MySQL database server? - mysql

So, I need a way to refresh the linked tables in my Access Database so that if the Internet disconnects for some reason the ODBC won't have an error when a query is sent and simply refreshes to see if the query can be sent again. However, the Access database doesn't reconnect for some reason when the Internet comes back up. Is there a way, in VBA, to refresh the linked tables if this does happen?

Would the .RefreshLink method do what you want?
There's an example here: https://msdn.microsoft.com/en-us/library/office/ff198349.aspx
Another solution would be to reconnect to the remote database calling this function.
Function ConnectODBC(ByVal strDsn As String, ByVal strDatabase As String, ByVal strUserName As String, ByVal strPassword As String)
Dim qdf As DAO.QueryDef
Dim rst As DAO.Recordset
Dim strConnection As String
strConnection = "ODBC;DSN=" & strDsn & ";" & _
"DATABASE=" & strDatabase & ";" & _
"UID=" & strUserName & ";" & _
"PWD=" & strPassword
Set qdf = CurrentDb.CreateQueryDef("")
With qdf
.Connect = strConnection
.SQL = "SELECT 1;"
End With
Set rst = qdf.OpenRecordset(dbOpenSnapshot, dbSQLPassThrough)
ConnectODBC = True
Set rst = Nothing
Set qdf = Nothing
End Function

Related

How to preserve linked tables in Access when copying to different machines

We have a Access DB with 1000+ linked tables and about 200 local tables.
We need this Access DB to reside on the desktops of about 40 users.
The problem is, each time I copy the Access file to a new PC, even though the ODBC connection name is the same for the linked tables, it always asks me to relink all 1000+ tables and I have to click okay 1000+ times.
Is there a way to save the file in such a way that it preserves the linked relationships and the ODBC name so I can easily copy it from machine to machine?
Use a DSN-less connection and a function to relink (only needed to switch database) all the tables and pass-through queries:
Public Function AttachSqlServer( _
ByVal Hostname As String, _
ByVal Database As String, _
ByVal Username As String, _
ByVal Password As String) _
As Boolean
' Attach all tables linked via ODBC to SQL Server or Azure SQL.
' 2016-04-24. Cactus Data ApS, CPH.
Const cstrDbType As String = "ODBC"
Const cstrAcPrefix As String = "dbo_"
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim qdf As DAO.QueryDef
Dim strConnect As String
Dim strName As String
On Error GoTo Err_AttachSqlServer
Set dbs = CurrentDb
strConnect = ConnectionString(Hostname, Database, Username, Password)
For Each tdf In dbs.TableDefs
strName = tdf.Name
If Asc(strName) <> Asc("~") Then
If InStr(tdf.Connect, cstrDbType) = 1 Then
If Left(strName, Len(cstrAcPrefix)) = cstrAcPrefix Then
tdf.Name = Mid(strName, Len(cstrAcPrefix) + 1)
End If
tdf.Connect = strConnect
tdf.RefreshLink
Debug.Print Timer, tdf.Name, tdf.SourceTableName, tdf.Connect
DoEvents
End If
End If
Next
For Each qdf In dbs.QueryDefs
If qdf.Connect <> "" Then
Debug.Print Timer, qdf.Name, qdf.Type, qdf.Connect
qdf.Connect = strConnect
End If
Next
Debug.Print "Done!"
AttachSqlServer = True
Exit_AttachSqlServer:
Set tdf = Nothing
Set dbs = Nothing
Exit Function
Err_AttachSqlServer:
Call ErrorMox
Resume Exit_AttachSqlServer
End Function
Public Function ConnectionString( _
ByVal Hostname As String, _
ByVal Database As String, _
ByVal Username As String, _
ByVal Password As String, _
Optional ByVal AdoStyle As Boolean) _
As String
' Create ODBC or ADO connection string from its variable elements.
' 2021-06-15. Cactus Data ApS, CPH.
Const AzureDomain As String = ".windows.net"
Const OdbcPrefix As String = "ODBC;"
Const OdbcConnect As String = _
"DRIVER=SQL Server Native Client 11.0;" & _
"Description=Cactus TimeSag og Finans;" & _
"APP=Microsoft® Access;" & _
"SERVER={0};" & _
"DATABASE={1};" & _
"UID={2};" & _
"PWD={3};" & _
"Trusted_Connection={4};"
Dim FullConnect As String
If Right(Hostname, Len(AzureDomain)) = AzureDomain Then
' Azure SQL connection.
' Append servername to username.
Username = Username & "#" & Split(Hostname)(0)
End If
If Not AdoStyle Then
FullConnect = OdbcPrefix
End If
FullConnect = FullConnect & OdbcConnect
FullConnect = Replace(FullConnect, "{0}", Hostname)
FullConnect = Replace(FullConnect, "{1}", Database)
FullConnect = Replace(FullConnect, "{2}", Username)
FullConnect = Replace(FullConnect, "{3}", Password)
FullConnect = Replace(FullConnect, "{4}", IIf(Username & Password = "", "Yes", "No"))
ConnectionString = FullConnect
End Function
Also, study my article: Deploy and update a Microsoft Access application with one click

open ADO recordset as visible table

I'm doing something like this for the first time and it seems incredibly hard to find any useful information at all.
What I want to do:
Pass a select-query to a MySQL database and show the result in a table.
I've got that far by now: I have a button on a form and when clicked the following happens
Option Compare Database
Sub RunPassThrough(strSQL As String)
Dim ConnectionString As String
Dim Server As String
Dim User As String
Dim Pwd As String
Dim DatabaseName As String
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
' Server Hostname (or IP)
Server = "192.168.178.10"
User = "user"
Pwd = "mypass"
DatabaseName = "myDB"
ConnectionString = "Provider=MSDASQL;Driver={MYSQL ODBC 5.1 DRIVER};" & _
"Server=" & Server & ";Database=" & DatabaseName
Set Cn = New ADODB.Connection
Cn.CursorLocation = adUseClient
Cn.Mode = adModeShareDenyNone
Cn.Open ConnectionString, User, Pwd
Set Rs = New ADODB.Recordset
Rs.Open strSQL, Cn, adOpenDynamic, adLockReadOnly
'Set Rs = Cn.Execute("select * from SurveyResults limit 10;")
End Sub
Private Sub Befehl0_Click()
Dim SQL As String
SQL = "select * from SurveyResults limit 10;"
RunPassThrough (SQL)
End Sub
I know that Rs.Open strSQL, Cn, adOpenDynamic, adLockReadOnly returns an ADO recordset and I could do things with it using VBA, but all I want is to show that recorod set to the user in table.
something like OpenRecordset("Rs", as a table that the user can see)
can someone please point me into the right direction I'm going crazy...
I figured it out. My problem was simply that the ReturnsRecords Property is set to false by default.
it works now, so I'm posting a answer if anyone ever needs it.
Sub RunPassThrough(strSQL As String)
Dim Server As String
Dim User As String
Dim Pwd As String
Dim DatabaseName As String
Dim qdfPassThrough As DAO.QueryDef, MyDB As Database
Dim strConnect As String
' Server Hostname (or IP)
Server = "192.168.178.10"
User = "user"
Pwd = "mypass"
DatabaseName = "database"
For Each qdf In CurrentDb.QueryDefs
If qdf.Name = "PassQuery" Then
CurrentDb.QueryDefs.Delete "PassQuery"
Exit For
End If
Next
strConnect = "ODBC;DRIVER={MYSQL ODBC 5.1 DRIVER};SERVER=" & Server & ";DATABASE=" & DatabaseName & ";Uid=" & User & ";Pwd=" & Pwd & ";"
Set MyDB = CurrentDb()
Set qdfPassThrough = MyDB.CreateQueryDef("PassQuery")
qdfPassThrough.Connect = strConnect
qdfPassThrough.SQL = strSQL
qdfPassThrough.Close
Application.RefreshDatabaseWindow
MyDB.QueryDefs("PassQuery").ReturnsRecords = True
DoCmd.OpenQuery "PassQuery", acViewNormal, acReadOnly
DoCmd.Maximize
End Sub

Access VBA - To get data from Excel file stored in Sharepoint

I have the below code working for me provided the "Model_data.xlsm" file is stored in my hard drive. Is it possible if Access can get the data from "model_data.xlsm" stored in Sharepoint?
Private Sub Update_manu_data_Click()
Dim strXls As String
strXls = CurrentProject.Path & Chr(92) & "Model_data.xlsm"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Manufacturing_data", _
strXls, True, "Combined!"
End Sub
Finally I did find a workaround for this issue.
I Created a private function in access to download the Excel file from SP and then used the Transferspread sheet function to retrieve the data into access table.
Below is the code i used to download the Excel file in SP using access Vba
Private Sub Command2_Click()
Dim Ex As Object
Dim Acc As Object
Dim strXls As String
Set Ex = CreateObject("Excel.Application")
Set Acc = Ex.Workbooks.Open("https://Sharepoint File link")
Ex.Visible = False
Acc.SaveAs "C:\Users\.......\test.xlsx"
Acc.Close
Ex.Quit
strXls = CurrentProject.Path & Chr(92) & "C:\Users\.......\test.xlsx"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Tablename", _
strXls, True, "Sheet(1)!"
End Sub
Sub ConnectToExcel()
Dim strSharePointPath As String
Dim strExcelPath As String
Dim strConnectionString As String
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
' Set the SharePoint path and Excel file name
strSharePointPath = "http://yoursharepointurl.com/YourSharePointFolder/"
strExcelPath = "YourExcelFile.xlsx"
' Build the connection string
strConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"WSS;IMEX=0;RetrieveIds=Yes;" & _
"DATABASE=" & strSharePointPath & ";" & _
"LIST=" & strExcelPath & ";"
' Open the connection
Set cnn = New ADODB.Connection
cnn.Open strConnectionString
' Open a recordset
Set rs = New ADODB.Recordset
rs.Open "SELECT * FROM [Sheet1$]", cnn
' Loop through the recordset and display the data
Do While Not rs.EOF
Debug.Print rs.Fields(0).Value
rs.MoveNext
Loop
' Clean up
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing
End Sub

Code to connect to encrypted / password-protected database

At start up, my front end front.accdr database links to a back end back.accde using:
DoCmd.TransferDatabase acLink, "Microsoft Access", "back.accde", acTable, "aTable", "aTable"
The back end really needs to be encrypted and so I need to use a password to connect to the encrypted DB. How would I do this?
If you can't find a way to include the database password with TransferDatabase, you can create the table link as a new member of the DAO.TableDefs collection.
I confirmed this code works in an Access 2007 ACCDR file.
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim strConnect As String
Dim strDbFile As String
Dim strLinkName As String
Dim strPassword As String
Dim strSourceTableName As String
strDbFile = "C:\share\Access\PasswordEquals_foo.accdb"
strPassword = "foo"
strSourceTableName = "Contacts"
strLinkName = "link_to_contacts"
strConnect = "MS Access;PWD=" & strPassword & _
";DATABASE=" & strDbFile
Debug.Print strConnect
Set db = CurrentDb
Set tdf = db.CreateTableDef
tdf.Connect = strConnect
tdf.SourceTableName = strSourceTableName
tdf.Name = strLinkName
db.TableDefs.Append tdf
Beware that, even with an ACCDR, anyone who can read the link's TableDef.Connect property will be able to see the stored database password. For example, the following code displays "MS Access;PWD=foo;DATABASE=C:\share\Access\PasswordEquals_foo.accdb" in the Immediate window.
Dim dbRemote As DAO.Database
Dim objWorkspace As Workspace
Set objWorkspace = CreateWorkspace("", "admin", "", dbUseJet)
Set dbRemote = objWorkspace.OpenDatabase("C:\share\Access\Database2.accdr")
Debug.Print dbRemote.TableDefs("link_to_contacts").Connect
dbRemote.Close
objWorkspace.Close
So the link compromises the security of an encrypted db file.
The method I used to do this is actually quite simple:
Set db = CurrentDb
Set dblink = DBEngine.OpenDatabase(strDbFile, False, False, ";PWD=" & strP)
For Each strTable In strLinkedTablesArray
DoCmd.TransferDatabase acLink, "Microsoft Access", dblink.name, acTable, _
strTable, strTable
Next

How to save an ADO recordset into a new local table in Access 2003?

I'm trying to import tables from a FoxPro 9.0 database into Access 2003. So far, from Google searches and many trials, the only way for me to connect to the tables is through an OLE DB connection programatically. I have set up 3 ODBC connections with different configurations but none of them work: I get "unspecified errors" that I can't find any information on.
With OLE DB I can succesfully connect to the FoxPro database, and import tables in ADO recordsets. The problem is that I can't save the recordset into new table in the local database using SQL. The ADO recordsets behave differently than tables, so I can't query them. The code below gives me a "type mismatch" error at DoCmd.RunCommand ("select * from " & rst & " INTO newClients").
Sub newAdoConn()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim strSQL As String
Dim decision As Integer
Set cnn = New ADODB.Connection
cnn.ConnectionString = "Provider=vfpoledb;" & _
"Data Source=s:\jobinfo\data\jobinfo.dbc;" & _
"Mode=ReadWrite|Share Deny None;" & _
"Collating Sequence=MACHINE;" & _
"Password=''"
strSQL = "Select * from Jobs"
cnn.Open
Set rst = cnn.Execute("Select * from clients")
If rst.EOF = False Then
Do While Not rst.EOF
decision = MsgBox(rst.Fields!ID & " " & rst.Fields!fname & " " & rst.Fields!lname & vbCrLf & vbCrLf & "Continue?", vbYesNo)
If decision = vbYes Then
rst.MoveNext
Else
Exit Do
End If
Loop
End If
DoCmd.RunCommand ("select * from " & rst & " INTO newClients")
rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
End Sub
I finally worked out a decent solution. It involves saving the ado recordset from memory to an excel file using the copyFromRecordset function, and then linking the file programmatically to a table in excel using the TransferSpreadsheet()...
Sub saveToExcel()
Dim cnn As ADODB.Connection
'declare variables
Dim rs As ADODB.Recordset
Dim strSQL As String
Dim decision As Integer
Dim colIndex As Integer
' Dim fso As New FileSystemObject
' Dim aFile As File
'set up connection to foxpro database
Set cnn = New ADODB.Connection
cnn.ConnectionString = "Provider=vfpoledb;" & _
"Data Source=s:\jobinfo\data\jobinfo.dbc;" & _
"Mode=ReadWrite|Share Deny None;" & _
"Collating Sequence=MACHINE;" & _
"Password=''"
cnn.Open
Set rs = cnn.Execute("Select * from clients")
'Create a new workbook in Excel
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Add
Set oSheet = oBook.Worksheets(1)
oSheet.Name = "clients"
' Copy the column headers to the destination worksheet
For colIndex = 0 To rs.Fields.Count - 1
oSheet.Cells(1, colIndex + 1).Value = rs.Fields(colIndex).Name
Next
'Transfer the data to Excel
oSheet.Range("A2").CopyFromRecordset rs
' Format the sheet bold and auto width of columns
oSheet.Rows(1).Font.Bold = True
oSheet.UsedRange.Columns.AutoFit
'delete file if it exists - enable scripting runtime model for this to run
'If (fso.FileExists("C:\Documents and Settings\user\Desktop\clients.xls")) Then
' aFile = fso.GetFile("C:\Documents and Settings\user\Desktop\clients.xls")
' aFile.Delete
'End If
'Save the Workbook and Quit Excel
oBook.SaveAs "C:\Documents and Settings\user\Desktop\clients.xls"
oExcel.Quit
'Close the connection
rs.Close
cnn.Close
MsgBox ("Exporting Clients Done")
'link table to excel file
DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel5, "clientsTest", "C:\Documents and Settings\user\Desktop\clients.xls", True
End Sub
What you will have to do is open the FoxPro table as a recordset and open the local table as another recordset. You can then loop through the FoxPro recordset and do something like this
Do until FoxProRst.EOF
LocatRst.AddNew
LocalRst!SomeField1=FoxProRst!SomeField1
LocalRst!SomeField2=FoxProRst!SomeField2
LocalRst!SomeField3=FoxProRst!SomeField3
LocalRst.Update
FoxProRst.MoveNext
Loop
It might not be the quickest way but it will work
Let me just sketch another approach with SQL queries, that could simplify:
'...
'not required for first time test:
'cnn.Execute("DROP TABLE MyNewTable")
'...
'create the new table in the destination Access database
cnn.Execute("CREATE TABLE MyNewTable (MyField1 int, MyField2 VARCHAR(20), MyField3 Int)")
'insert data in the new table from a select query to the original table
Dim sSQL as string, MyOriginalDBPath as String
sSQL = "INSERT INTO MyNewTable (MyField1, MyField2, MyField3) SELECT OriginalField1, OriginalField2, OriginalField3 FROM [" & MyOriginalDBPath & ";PWD=123].clients"
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open sSQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText
'...
Note: this 'draft' idea assumes that the connection string is made to the Access database and the connection to the original database would be inside the SQL string, but i have not idea about the correct sintaxis. I have only tested this approach with different access databases.
Note that this is for Access: ...[" & MyOriginalDBPath & ";PWD=123]...
The Jet database engine can reference external databases in SQL statements by using a special syntax that has three different formats:
[Full path to Microsoft Access database].[Table Name]
[ISAM Name;ISAM Connection String].[Table Name]
[ODBC;ODBC Connection String].[Table Name]
...
You can use an ODBC Data Source Name (DSN) or a DSN-less connection string:
DSN: [odbc;DSN=;UID=;PWD=]
DSN-less: [odbc;Driver={SQL Server};Server=;Database=;
UID=;PWD=]
Some references:
Querying data by joining two tables in two database on different servers
C# - Join tables from two different databases using different ODBC drivers
Why not use ODBC to link to the table? http://support.microsoft.com/kb/225861