Linking Back end Databse with password. (1 Viewer)

[jdlc]

Hi Guys,

I have a Back end (with password) which resides in a netdrive while the front end is installed in each individual users desktop, the problem is, some of the users netdrive was mapped in a different way (different letters..some are J others are G). I'm looking for code that I can relink the database to the front end in runtime, I did try to look in the net but I can't find anything that I can put the password as parameter.

this sample code from Dev is good, but i got an error because the database requires a password. can somebody show me where i can put the password?

Thanks in advance.

'***************** 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(NewDbName As String) 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
    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?"
    'strNewPath = NewDbName
    If MsgBox(strMsg, vbQuestion + vbYesNo, "Alternate data source...") = vbYes Then
        strNewPath = fGetMDBName("Please select a new datasource")
    Else
        strNewPath = vbNullString
    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)
            '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
                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 3059:
        Case cERR_USERCANCEL:
            MsgBox "No Database was specified, couldn't link tables.", _
                    vbCritical + vbOKOnly, _
                    "Error in refreshing links."
            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."
            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, _
                    "Access Database(*.mdb;*.mda;*.mde;*.mdw) ", _
                    "*.mdb; *.mda; *.mde; *.mdw")
    strFilter = ahtAddFilterItem(strFilter, _
                    "All Files (*.*)", _
                    "*.*")
    fGetMDBName = ahtCommonFileOpenSave(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 ***************

 

[AOB]

Try this?...

With tdfLocal
    .Connect = [COLOR=red]";PWD=" & strPassword &[/COLOR] ";Database=" & strDBPath
    .RefreshLink
    collTbls.Remove (.Name)
End With

Obviously replace strPassword with the relevant string...

 

[jdlc]

Try this?...

With tdfLocal
    .Connect = [COLOR=red]";PWD=" & strPassword &[/COLOR] ";Database=" & strDBPath
    .RefreshLink
    collTbls.Remove (.Name)
End With

Obviously replace strPassword with the relevant string...

thanks aob for the reply, i appreciate it , i already insert your suggestion but i think before it reach that code this command makes an error due to password too.

Set dbLink = DBEngine(0).OpenDatabase(strDBPath)

any idea where to put the password in this code?

thanks boss

 

[AOB]

If you have the intellisense turned on, you'll see that [Connect] is one of the optional arguments to pass as part of the .OpenDatabase routine :

OpenDatabase (Name As String, [Options], [ReadOnly], [COLOR=red][Connect][/COLOR]) As Database

This article should help you put that string together, should be something like :

DBEngine.OpenDatabase (strDBPath, , , [COLOR=red]"MS Access;PWD=" & strPassword[/COLOR])

 

[gemma-the-husky]

note that if users can see the tables, then they can also see the password displayed in the connect string, in plain text. as far as I know, there is no way to prevent this

 

[jdlc]

If you have the intellisense turned on, you'll see that [Connect] is one of the optional arguments to pass as part of the .OpenDatabase routine :

OpenDatabase (Name As String, [Options], [ReadOnly], [COLOR=red][Connect][/COLOR]) As Database

This article should help you put that string together, should be something like :

DBEngine.OpenDatabase (strDBPath, , , [COLOR=red]"MS Access;PWD=" & strPassword[/COLOR])

i tried but still password in error. i tried it manually and the password is ok. so sorry it's been a week now that i tried everything but it just seem not working. i just want to relink the back end to the front end at runtime whenever the back end is moved or mapped in a different netdrive.

 

[AOB]

Can you isolate exactly where the error arises via debugging and what that error is?

Maybe try surrounding the password with quotes (but from memory I don't think you're actually supposed to?...)

 

[AOB]

Also, do you have to physically 'open' the database? Surely all you want to do is relink your front-end to the relevant tables in the BE, i.e. update the .Connect property of the appropriate table definition? Why do you have to 'open' the backend?

 

[jdlc]

Also, do you have to physically 'open' the database? Surely all you want to do is relink your front-end to the relevant tables in the BE, i.e. update the .Connect property of the appropriate table definition? Why do you have to 'open' the backend?

the error occured in this line of code, and the error message is "Invalid Password"

Set dbLink = DBEngine(0).OpenDatabase(strDBPath)

I tried your code your suggestion and same error that i have.

DBEngine.OpenDatabase (strDBPath, , , "MS Access;PWD=" & strPassword)

i have a code to refresh the links (in case the FE was moved into a different location. but what i'm trying to do is, what if the BE was moved into other location, the system should detect it and will prompt the user to locate the BE, delete the old link then re-establish a new connection or link.

thanks for your patience with me boss.