Unanswered: link password protected tables with VBA
I'm using Access97.
I've got a front-end that links to a back-end on the network. I have 2 copies of the back-end that are structually identical. One is the "live" back-end; the other is the "test" db.
I have a form with option buttons that allows the selection of one of the back-end databases so I can do my testing without destroying real data when I make developement changes. This launches a function that deletes the linked tables in the front-end and creates new links to the tables in the selected back-end.
I am now using this procedure with a back-end database that is password protected and it prompts me for the password for each table. I have tried in vain to create a connection to the database using the password.
Can anyone help?
Here's the procedure that does the re-linking:
Sub Link_Selected_DB(iSDB As Integer)
'This procedure removes the links to tables listed in the "Linked_Tables" table _
and creates new links to those same tables in the selected back-end database
'SDB is an integer with the value of the selected option button on the DB_Select form _
It is used to set parameters for linking to the correct back-end database.
On Error GoTo DB_Link_Err
Dim TargetDB As String
Dim rsTableNames As Recordset 'Recordset to hold names of tables to be linked
Dim x As Integer 'Number of tables to link
Dim i As Integer
Dim DbName As String 'Name of connected Database
Dim AppTitle As String 'Application Title
Dim MyVer As Double '
Set rsTableNames = CurrentDb.OpenRecordset("SELECT Linked_Tables.Table_Name " & _
'Get path and filename for selected database
Select Case iSDB
DbName = "Production"
TargetDB = "\\server\path\database.mdb"
DbName = "Test"
TargetDB = "\\server\path\databasetest.mdb"
DbName = "x"
TargetDB = "path\filename"
DbName = "DB Label here"
TargetDB = "path here"
If Err <> 3011 Then
MsgBox "Error Number: " & Err.Number & vbCrLf & "Error Description: " & Error$
Function AddAppProperty(strName As String, varType As Variant, varValue As Variant) As Integer
Dim dbs As Database, prp As Property
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo AddProp_Err
dbs.Properties(strName) = varValue
AddAppProperty = True
If Err = conPropNotFoundError Then
Set prp = dbs.CreateProperty(strName, varType, varValue)
AddAppProperty = False