Relinking Multiple Password Protected FE and BE

[moishy]

Cheers all Experts,

I am currently using the following code to relink password protected BE to a FE, as the comments clearly say it will not work with multiple BE. How can the code be adjusted to work with multiple password protected BE?

Function RefreshLinks(MyDbName As String, pwd As String) As Boolean
    ' Refresh links to the supplied database. Return True if successful.
    ' Attempts to connect to mdb named in the jetdatapath setting
    ' Application fails if mdb not found
    ' This demo assumes that all the linked tabled appear in the same back end
    ' Code will need to be manipulated if using side ends.
    ' Also need to ensure that Miscrosoft DAO 3.6 Object library is referenced

    '/Display message on status bar
    DoCmd.Echo True, "Refreshing table links, please wait..."
    Dim dbs As DAO.Database
    Dim tdf As DAO.TableDef

    '/Does the path exist
    If Dir(MyDbName) = "" Then
        MsgBox "Sorry, can't open the BE.", vbCritical, "Error"
    End If

    ' Loop through all tables in the database.
    Set dbs = CurrentDb
    For Each tdf In dbs.TableDefs
        ' If the table has a connect string, it's a linked table.
        If Len(tdf.Connect) > 0 Then
            If tdf.Connect <> ";DATABASE=" & MyDbName & ";PWD=" & pwd Then
                tdf.Connect = ";DATABASE=" & MyDbName & ";PWD=" & pwd
                Err = 0
                On Error Resume Next
                tdf.RefreshLink         ' Relink the table.
                If Err <> 0 Then
                    RefreshLinks = False
                    MsgBox "Wrong Password!", vbExclamation, "Error"
                    Exit Function
                End If
            End If
        End If
    Next tdf
    DoCmd.Echo True, "Done"

    RefreshLinks = True        ' Relinking complete.
End Function

 

[Rx_]

Perhaps build a database table with the name of the database, DB location, and the db password.
Put this function inside a loop - see that you already have the DB/PW set as parameters to pass into it.

For the master db holding passwords, it might be worthwile to use as SQL Server db. Or at least looking at encrypting your Access DB (or put it into a very password controlled secured folder). Is that the kind of thing you are looking for?

 

[moishy]

Thanks for the response. I don't think that is what I'm looking for.

I have seen many examples of relinking multiple BE, but I don't see how the above function differs from them. I would like to simply make the above function work.

Thank you.

 

[Rx_]

strSaveCurConnectProp See in JStreet Access Relinker http://www.jstreettech.com/cartgenie/pg_developerDownloads.asp
Another example as an FYI.

DCRake has a previous posted code for relinking -
http://www.access-programmers.co.uk/forums/showthread.php?t=204413
Is this along the line of what you are trying to accomplish with your code?
I can't see any major difference in yours either.

http://www.access-programmers.co.uk/forums/showthread.php?t=233111&highlight=tdf.Connect+%3D+%3BDATABASE%3D
This one has an additional argument

I am totally using SQL Server now - but hope you will share anything found to make your code work.

 

[moishy]

Thanks for the links.

I think I got it to work, I just removed the following lines:

If Err <> 0 Then                     
      RefreshLinks = False 
      MsgBox "Wrong Password!", vbExclamation, "Error" 
      Exit Function 
End If

 

[Rx_]

That is interesting. If you put a break point on the If Err <> 0 then - is the error number in fact zero? Or, what error is it?
Just wondering if the table refresh was the problem? Mine wouldn't show the icons refreshed. Used a combination of:

CurrentDb.Containers("Tables").Documents.Refresh


Sub RerefreshLinkedTables() ' refreshes Linked tables doesn't refresh icon
Dim dbs As DAO.Database
Dim tdf As TableDef
10 Set dbs = CurrentDb
20 For Each tdf In dbs.TableDefs
30 If Len(tdf.Connect) > 0 Then
40 tdf.RefreshLink
Debug.Print tdf.Name
50 End If
60 Next tdf
70 Set dbs = Nothing
End Sub

As if the Front-End needed a nudge.
Manually changing the object explorer from tables, to query, then back to tables seemed to cause the refresh of the icons. So a combo of the two codes seemed to take care of this. Just wondering if the error number persist while an icon is waiting to be refreshed?

 

[moishy]

I get error 3011

 

[Rx_]

Just in case: Does the Startup form have bound controls?


Here is a code example of an error trap that at least describes the errors:
ReLinkBE_Exit:

On Error GoTo ReLinkBE_Error  ' at top

    Exit Function ' paste this just above the end function 
ReLinkBE_Error:
    Select Case Err.Number
        Case 3011   'Bad Table Name
            strMsg = "Table Not Found"
        Case 3024   'File Name Not Found
            strMsg = "Database File Name Not Found"
        Case 3044   'Path Not found
            strMsg = "Database Path Not Found"
        Case Else
            strMsg = "Error " & Err.Number & " (" & Err.Description & _
                ") in procedure ReLinkBE of Module modUtilities"
    End Select
    MsgBox strMsg, vbExclamation, "Call Support"
    RefreshLinks  = False

The Solution to your Code
This modification should allow connection to multiple databases
Wish I could cite an exact solution - it was kind of vague in a couple of places.
The for Each tdf in dbs.tabledefs becomes read-only as a connection is set.
By reading the TableDefs.count and re-setting it to an object variable - it re-establishes your connection string each time. This modification is to be used right after your Set dbs = currentdb
Suggest:
For i = 0 To dbs.TableDefs.Count - 1
Set tdf = dbs.TableDefs(i)

(you will need to dim i as integer and change the Next Tdf to Next i)
There is a difference between connecting to one DB or multiple DB.
Try this code out and let us know. My connections are to SQL Server so it makes testing on my end more difficult.

If it works, please submit your working solution for others and add the tags for searching at the bottom