Password when reconnecting linked tables

[Motion]

Hi all

I am currently using the following code to reconnect linked tables in the back end but cannot seem to establish the correct method to incorporate a password into the code. The password is needed as the backend has a database password.

I want to keep the same password each time and i don't want the user to be prompted for it.

Any ideas anyone?

Much appreciated

Richard

'***************** Code Start ***************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
Function fRefreshLinks() As Boolean
Dim strMsg As String, collTbls As Collection
Dim i As Integer, strDBPath As String, strTbl As String
Dim dbCurr As Database, dbLink As Database
Dim tdfLocal As TableDef
Dim varRet As Variant
Dim strNewPath As String

Const cERR_USERCANCEL = vbObjectError + 1000
Const cERR_NOREMOTETABLE = vbObjectError + 2000

On Local Error GoTo fRefreshLinks_Err

FileLinked = "Yes"

'If MsgBox("Are you sure you want to reconnect all Access tables?", _
'vbQuestion + vbYesNo, "Please confirm...") = vbNo Then Err.Raise cERR_USERCANCEL



'First get all linked tables in a collection
Set collTbls = fGetLinkedTables

'now link all of them
Set dbCurr = CurrentDb

'strMsg = "Do you wish to specify a different path for the Access Tables?"

'If MsgBox(strMsg, vbQuestion + vbYesNo, "Alternate data source...") = vbYes Then
strNewPath = fGetMDBName("Open file")
'Else
If strNewPath = vbNullString Then
FileLinked = "No"
Err.Raise cERR_USERCANCEL
End If

For i = collTbls.Count To 1 Step -1
strDBPath = fParsePath(collTbls(i))
strTbl = fParseTable(collTbls(i))
varRet = SysCmd(acSysCmdSetStatus, "Now linking '" & strTbl & "'....")
If Left$(strDBPath, 4) = "ODBC" Then
'ODBC Tables
'ODBC Tables handled separately
' Set tdfLocal = dbCurr.TableDefs(strTbl)
' With tdfLocal
' .Connect = pcCONNECT
' .RefreshLink
' collTbls.Remove (strTbl)
' End With
Else
If strNewPath <> vbNullString Then
'Try this first
strDBPath = strNewPath
Else
If Len(Dir(strDBPath)) = 0 Then
'File Doesn't Exist, call GetOpenFileName
strDBPath = fGetMDBName("'" & strDBPath & "' not found.")
If strDBPath = vbNullString Then
'user pressed cancel
Err.Raise cERR_USERCANCEL
End If
End If
End If

'backend database exists
'putting it here since we could have
'tables from multiple sources
Set dbLink = DBEngine(0).OpenDatabase(strDBPath)

pwd = bypass1111

'check to see if the table is present in dbLink
strTbl = fParseTable(collTbls(i))
If fIsRemoteTable(dbLink, strTbl) Then
'everything's ok, reconnect
Set tdfLocal = dbCurr.TableDefs(strTbl)
With tdfLocal
.Connect = ";Database=" & strDBPath
.RefreshLink
collTbls.Remove (.Name)
End With
Else
FileLinked = "No"
Err.Raise cERR_NOREMOTETABLE
End If
End If
Next
fRefreshLinks = True
varRet = SysCmd(acSysCmdClearStatus)

'MsgBox "All Access tables were successfully reconnected.", _
' vbInformation + vbOKOnly, _
' "Success"

fRefreshLinks_End:
Set collTbls = Nothing
Set tdfLocal = Nothing
Set dbLink = Nothing
Set dbCurr = Nothing
Exit Function
fRefreshLinks_Err:
fRefreshLinks = False
Select Case Err

Case 3024:

MsgBox "File is not an Advanced Rehab company file", vbCritical, "Advanced Rehab"
FileLinked = "No"

Resume fRefreshLinks_End


Case 3059:

Case 3078:

MsgBox "File is not an Advanced Rehab company file", vbCritical, "Advanced Rehab"
FileLinked = "No"

Resume fRefreshLinks_End

Case cERR_USERCANCEL:
'MsgBox "No path was specified, couldn't open file.", _
' vbCritical + vbOKOnly, _
' "Advanced Rehab."
Resume fRefreshLinks_End
Case cERR_NOREMOTETABLE:

'MsgBox "Table '" & strTbl & "' was not found in the database" & _
' vbCrLf & dbLink.Name & ". Couldn't refresh links", _
' vbCritical + vbOKOnly, _
' "Error in refreshing links."

MsgBox "File is not an Advanced Rehab company file", vbCritical, "Advanced Rehab"


Resume fRefreshLinks_End
Case Else:
strMsg = "Error Information..." & vbCrLf & vbCrLf
strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf
strMsg = strMsg & "Description: " & Err.Description & vbCrLf
strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
MsgBox strMsg, vbOKOnly + vbCritical, "Error"
Resume fRefreshLinks_End
End Select
End Function

Function fIsRemoteTable(dbRemote As Database, strTbl As String) As Boolean
Dim tdf As TableDef
On Error Resume Next
Set tdf = dbRemote.TableDefs(strTbl)
fIsRemoteTable = (Err = 0)
Set tdf = Nothing
End Function

Function fGetMDBName(strIn As String) As String
'Calls GetOpenFileName dialog
Dim strFilter As String

strFilter = ahtAddFilterItem(strFilter, _
"Advanced Rehab Company File (*.arf) ", _
"*.arf")

strFilter = ahtAddFilterItem(strFilter, _
"All Files (*.*)", _
"*.*")

fGetMDBName = ahtCommonFileOpenSave(InitialDir:=strDBPath, Filter:=strFilter, _
OpenFile:=True, _
DialogTitle:=strIn, _
Flags:=ahtOFN_HIDEREADONLY)
End Function

Function fGetLinkedTables() As Collection
'Returns all linked tables
Dim collTables As New Collection
Dim tdf As TableDef, db As Database
Set db = CurrentDb
db.TableDefs.Refresh
For Each tdf In db.TableDefs
With tdf
If Len(.Connect) > 0 Then
If Left$(.Connect, 4) = "ODBC" Then
' collTables.Add Item:=.Name & ";" & .Connect, KEY:=.Name
'ODBC Reconnect handled separately
Else
collTables.Add Item:=.Name & .Connect, Key:=.Name
End If
End If
End With
Next
Set fGetLinkedTables = collTables
Set collTables = Nothing
Set tdf = Nothing
Set db = Nothing
End Function

Function fParsePath(strIn As String) As String
If Left$(strIn, 4) <> "ODBC" Then
fParsePath = Right(strIn, Len(strIn) _
- (InStr(1, strIn, "DATABASE=") + 8))
Else
fParsePath = strIn
End If
End Function

Function fParseTable(strIn As String) As String
fParseTable = Left$(strIn, InStr(1, strIn, ";") - 1)
End Function
'***************** Code End ***************

 

[BrettM]

If both FrontEnd and BackEnd are in the same directory then this will work for you. If not then you will need to supply your own value for "PathNew".

The DEBUG.PRINT lines are there simply to show what is happening. If you wish to use them, remove the comments and run the code from within your VB editor. Also - remember to comment the "db.TableDefs(i).RefreshLink" line so no real changes are made.

Create an Autoexec Macro to call this Function at startup.

Remove the "If Source <> path Then" line and its associated "End If" to have the reconnection happen every time.

Function Reconnect()
'*************************************************************
'*      Use an Autoexec Macro to call this function.         *
'*      It will reconnect all links when the FrontEnd        *
'*      and the BackEnd are in the same directory.           *
'*      It also keeps any password settings intact.          *
'*                                                           *
'*      Uncomment the Debug.Print lines and comment out      *
'*      the "db.TableDefs(i).RefreshLink" line to see        *
'*      structure by running code directly.                  *
'* ***********************************************************
Dim db As DAO.Database, Source As String, pathNew As String, pathOld As String
Dim SourceName As String, i As Integer, j As Integer
Set db = CurrentDb
pathNew = CurrentProject.path & "\"
'Debug.Print "New Path = " & pathNew
For i = 0 To db.TableDefs.Count - 1
    If db.TableDefs(i).Connect <> "" Then
        Source = db.TableDefs(i).Connect
        SourceName = right(Source, Len(Source) - (InStr(1, Source, "DATABASE=") + 8))
'        Debug.Print "Connect = " & Source
 
        For j = Len(SourceName) To 1 Step -1
            If Mid(SourceName, j, 1) = Chr(92) Then
                pathOld = Mid(SourceName, 1, j)
                SourceName = Mid(SourceName, j + 1, Len(SourceName))
'                Debug.Print "SourceName = " & SourceName
'                Debug.Print "Old Path = " & pathOld
               Exit For
            End If
        Next
        Source = left(Source, Len(Source) - (InStr(1, Source, "DATABASE=") - 10))
'        Debug.Print "Connect Start = " & Source
'        Debug.Print "Old Connect for " & db.TableDefs(i).Name & " = " & db.TableDefs(i).Connect
        If Source <> path Then
            db.TableDefs(i).Connect = Source + pathNew + SourceName
            db.TableDefs(i).RefreshLink
        End If
'        Debug.Print "new Connect for " & db.TableDefs(i).Name & " = " & db.TableDefs(i).Connect
    End If
Next
End Function

Hope this helps.

Regards Brett

 

[BrettM]

I found an error in the last routine I gave to fix the backend password issue. This one works correctly.

Function Reconnect()
On Error GoTo ReconError
Dim db As DAO.Database, Source As String, pathNew As String, pathOld As String
Dim SourceName As String, i As Integer, j As Integer, k As Integer
Set db = CurrentDb
pathNew = CurrentProject.path & "\"
'Debug.Print "Current Path = " & pathNew
For i = 0 To db.TableDefs.Count - 1
    If db.TableDefs(i).Connect <> "" Then
        Source = db.TableDefs(i).Connect
'        Debug.Print "Old Master Connect = " & Source
        SourceName = right(Source, Len(Source) - (InStr(1, Source, "DATABASE=") + 8))
'        Debug.Print "Old Master Name = " & SourceName
        k = Len(SourceName)
 
        For j = Len(SourceName) To 1 Step -1
            If Mid(SourceName, j, 1) = Chr(92) Then
                pathOld = Mid(SourceName, 1, j)
                SourceName = Mid(SourceName, j + 1, Len(SourceName))
'                Debug.Print "Source Name = " & SourceName
'                Debug.Print "Old Path = " & pathOld
               Exit For
            End If
        Next
        Source = left(Source, Len(Source) - k)
        If Source <> pathNew Then
'            Debug.Print "Connect Source = " & Source
'            Debug.Print "Old Connect for " & db.TableDefs(i).Name & " = " & db.TableDefs(i).Connect
            db.TableDefs(i).Connect = Source + pathNew + SourceName
            db.TableDefs(i).RefreshLink
        End If
'        Debug.Print "new Connect for " & db.TableDefs(i).Name & " = " & db.TableDefs(i).Connect
    End If
Next
ReconError:
End Function

Regards Brett

 

[mondo3]

where in this code is the password setup for the connection?

 

[BrettM]

The password is pulled from the old connection strings. This routine is not designed to change the password, only to reconnect.

As described in my first reply, try uncommenting some of the lines and run the code and see what I mean. Debug.Print "Old Master Connect = " & Source will give the full initial string including the current password. Also - remember to comment the db.TableDefs(i).RefreshLink line so no real changes are made while you review the code.

Hope this helps,
Regards Brett