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
Related
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
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
I have 5-6 clients to whom I will be selling my Access based Product. Where there is Back-end Database file (Password Protected). Access accdr Front-end file which saves data in back-end file. The location of the backend file will change client to client, hence want to have a VBA Code which links front-end t back-end.
I tried the below code
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0; " _
& Data Source= " & "C:\MyDB_be.accdb" & ";" _
& "Jet OLEDB:Database Password=123;"
But, the tables are not getting reconnected.
I Got the above code from this Ques on Stackoverflow.
Then I tried the below code
Const LnkDataBase = "C:\MyDB_be.accdb"
Sub relinktables()
'Routine to relink the tables automatically. Change the constant LnkDataBase to the desired one and run the sub
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim strTable As String
Set dbs = CurrentDb()
For Each tdf In dbs.TableDefs
If Len(tdf.Connect) > 1 Then 'Only relink linked tables
If tdf.Connect <> ";DATABASE=" & LnkDataBase Then 'only relink tables if the are not linked right
If Left(tdf.Connect, 4) <> "ODBC" Then 'Don't want to relink any ODBC tables
strTable = tdf.Name
dbs.TableDefs(strTable).Connect = ";DATABASE=" & LnkDataBase
dbs.TableDefs(strTable).RefreshLink
End If
End If
End If
Next tdf
End Sub
This works, when the file is not password protected. This code I got from This Ques. But there is no provision of specifying password.
Please help me out.
Either point out mistake in 1st code. OR How to specify password in
2nd Code OR New code altogether.
Spent 4 hrs on searching for solution. New to access VBA.
Went through this and this, but did not understand how to implement.
Give this a try:
Const LnkDataBase = "C:\MyDB_be.accdb"
Sub relinktables()
'Routine to relink the tables automatically. Change the constant LnkDataBase to the desired one and run the sub
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim strTable As String
Set dbs = CurrentDb()
For Each tdf In dbs.TableDefs
If Len(tdf.Connect) > 1 Then 'Only relink linked tables
If tdf.Connect <> ";DATABASE=" & LnkDataBase Then 'only relink tables if the are not linked right
If Left(tdf.Connect, 4) <> "ODBC" Then 'Don't want to relink any ODBC tables
strTable = tdf.Name
dbs.TableDefs(strTable).Connect = "Provider=Microsoft.ACE.OLEDB.12.0; " _
& "Data Source= " & LnkDataBase & ";" _
& "Jet OLEDB:Database Password=123;"
dbs.TableDefs(strTable).RefreshLink
End If
End If
End If
Next tdf
End Sub
After investing another 4 Hrs to this problem. Finally found the solution.
This is the code which worked flawlessly.
Const LnkDataBase = "C:\MyDB_be.accdb"
Const DBPassword = "123"
Sub relinktables()
'Routine to relink the tables automatically. Change the constant LnkDataBase to the desired one and run the sub
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim strTable As String
Set dbs = CurrentDb()
For Each tdf In dbs.TableDefs
If Len(tdf.Connect) > 1 Then 'Only relink linked tables
If tdf.Connect <> ";DATABASE=" & LnkDataBase Then 'only relink tables if the are not linked right
If Left(tdf.Connect, 4) <> "ODBC" Then 'Don't want to relink any ODBC tables
strTable = tdf.Name
dbs.TableDefs(strTable).Connect = "MS Access;PWD=" & DBPassword & ";DATABASE=" & LnkDataBase
dbs.TableDefs(strTable).RefreshLink
End If
End If
End If
Next tdf
End Sub
I would encourage VBA Experts to add their comments OR Modify this code to add Error Debugging. Like - IF PC is not connected to network, and the path specified is on Network, then Access hangs. This issue is yet to be fixed.
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
Is there a way to programmatically convert an Access 2010 ACCDB file to an Access 95/97 MDB file?
Here are some notes. I do not have an old version to play around with, so I do not know if you can import more than you can export:
Dim ws As Workspace
Dim db As Object
Dim tdf As TableDef
Dim qdf As QueryDef
Dim dbExp As Database
Dim acApp As New Access.Application
acApp.OpenCurrentDatabase "z:\docs\demo.accdb"
Set dbExp = acApp.CurrentDb
Set ws = DBEngine.Workspaces(0)
FName = "z:\docs\oldver95.mdb"
''Access 95
Set db = ws.CreateDatabase(FName, dbLangGeneral, dbVersion30)
''You can only export tables and a limited range of datatypes
For Each tdf In dbExp.TableDefs
If Left(tdf.Name, 4) <> "Msys" Then
acApp.DoCmd.TransferDatabase acExport, "Microsoft Access", _
FName, acTable, tdf.Name, tdf.Name
End If
Next
See http://msdn.microsoft.com/en-us/library/office/bb243161(v=office.12).aspx
A few notes using VBScript to demonstrate using the engine:
Dim objEngine
Dim objWS
Dim objDB
Dim db: db = "z:\docs\oldver95.mdb"
Set objEngine = CreateObject("DAO.DBEngine.36")
Set objDB = objEngine.OpenDatabase(db)
strSQL="SELECT * FROM Table1"
objDB.CreateQueryDef "Query1", strSQL