Problem trying to relink back end

[Petrol]

I want to distribute my DB to different "departments". Each will have their own BE data (all the same format and structure, but each with their own pwd) and all will use a common FE to access it.

So the plan is to distribute the common FE and a dummy BE, with the string "nulldata" in its name ("...nulldata..."). The nulldata BE has a simple pwd known to the FE when I distribute it. The remote users then copy the dummy BE and rename the copy as "...livedata..." ready to add their own data into it. They then decrypt and re-encrypt their livedata with their own password. I expected they could open the FE (pointing to nulldata) and use my code, with a pwd they supply, to link to their livedata.

But it doesn't work. My code is

strConnect = "MS Access;PWD=xxx;DATABASE=K:\Emmaus BS testdata_be.accdb"
For Each tbl In CurrentDb.TableDefs
    If InStr(tbl.Connect, Currently) > 0 Then              ' i.e. if it is a linked table (they all are, usually!)
        TableName = tbl.Name & " table: "                  ' Extract table name for possible error message
        tbl.Connect = strConnect                           ' same connect string for all linked tables
    End If
Next tbl 

("Currently" is a string variable containing a string known to exist in the BE file name - in this case, "null").
The code runs to completion, but doesn't change the links; in the navigation pane I see the tables still linked to the original BE.

I tried replacing the tbl.connect line with tbl.refreshlink, but that made no difference.
So I preceded the tbl.connect line with

DoCmd.DeleteObject acTable, TableName

. That made a difference - I now get Error No. 7874, "Emmaus BS DB can't find the object '~TMPCLP191411'.".

Does anyone know how I can get out of this?
I have no idea what object ~TMPCLP191411 is.

[NeoPa]

The missing link here is :

Call tbl.RefreshLink()

Give me 5 mins & I'll dig up a module for you that may be helpful.

[NeoPa]

Hi Petrol.

See if this procedure helps. It has links to other modules but there are various concepts illustrated in here that should save you lots of time & effort. I've tried to include the other procedures it references but there may be some omitted.

Linked tables can be identified by their Attributes, as you'll see below :
RelinkTables()

Public Const conConnect As String = "MS Access;PWD=%P;DATABASE=%D"
'RelinkTables() ensures that all Jet-linked tables currently linked to
'  strOldPath will be relinked to strNewPath.
Public Function RelinkTables(ByVal strOldPath As String _
                           , ByVal strNewPath As String _
                           , ByVal strPW As String _
                           , Optional ByRef dbVar As DAO.Database _
                           , Optional ByVal blnPW As Boolean = True) As Integer
    Dim tdfVar As DAO.TableDef
 
    On Error Resume Next
    If strNewPath = strOldPath Then Exit Function
    If Not Exist(strNewPath) Then Exit Function
    If dbVar Is Nothing Then Set dbVar = CurrentDb()
    For Each tdfVar In dbVar.TableDefs
        Call Err.Clear
        With tdfVar
            If (.Attributes And dbAttachedTable) Then
                If InStr(1, .Connect, strOldPath) > 0 Then
                    If blnPW Then
                        .Connect = MultiReplace(conConnect _
                                              , "%P", Scramble(strPW) _
                                              , "%D", strNewPath)
                    Else
                        .Connect = MultiReplace(conConnect _
                                              , "MS Access;PWD=%P", "" _
                                              , "%D", strNewPath)
                    End If
                    Call .RefreshLink
                    If Err = 0 Then RelinkTables = RelinkTables + 1
                End If
            End If
        End With
    Next tdfVar
End Function

'Exist() returns true if strFile exists.  By default ignores folders.
'22/05/2003 Rewritten with better code.
'20/05/2005 Added finding of R/O, System & Hidden files.
'11/12/2012 Added handling of inaccessible drives.
'22/05/2013 Added code to avoid false positives for folders.
Public Function Exist(ByVal strFile As String _
                    , Optional intAttrib As Integer = vbReadOnly _
                                                   Or vbHidden _
                                                   Or vbSystem) As Boolean
    On Error Resume Next
    'Strip trailing "\" characters as this gives a false reading.
    If Right(strFile, 1) = "\" Then strFile = Left(strFile, Len(strFile) - 1)
    Exist = (Dir(PathName:=strFile, Attributes:=intAttrib) <> "")
End Function

'MultiReplace() takes each pair of parameters from avarArgs() and replaces the
'  first with the second wherever found in strMain.
'Using VbBinaryCompare means that case is recognised and not ignored.
'08/05/2013 Updated to support passing of an array directly into avarArgs.
Public Function MultiReplace(ByRef strMain As String _
                           , ParamArray avarArgs() As Variant) As String
    Dim intX As Integer
    Dim avarVals() As Variant
 
    'Code to handle avarArgs passed as an existing array.
    If (UBound(avarArgs) = LBound(avarArgs)) _
    And IsArray(avarArgs(LBound(avarArgs))) Then
        ReDim avarVals(LBound(avarArgs) To UBound(avarArgs(LBound(avarArgs))))
        For intX = LBound(avarVals) To UBound(avarVals)
            avarVals(intX) = avarArgs(LBound(avarArgs))(intX)
        Next intX
    Else
        avarVals = avarArgs
    End If
    If (UBound(avarVals) - LBound(avarVals)) Mod 2 = 0 Then Stop
    MultiReplace = strMain
    For intX = LBound(avarVals) To UBound(avarVals) Step 2
        MultiReplace = Replace(Expression:=MultiReplace, _
                               Find:=Nz(avarVals(intX), ""), _
                               Replace:=Nz(avarVals(intX + 1), ""), _
                               Compare:=vbBinaryCompare)
    Next intX
End Function

NB. It works just as well for ACE as for Jet (-linked tables).

[NeoPa]

DoCmd.DeleteObject acTable, TableName

You're better off using proper VBA object code than using the pseudo-operator object (DoCmd) wherever & whenever possible. Also, avoid using CurrentDb() directly for anything but the most trivial of uses. It's a function not an object per se. It never returns the same object twice. Very wasteful and causes problems if allowed.

Dim strTableName As String
Dim dbVar As DAO.Database
 
strTableName = "~TMPCLP191411"
If dbVar Is Nothing Then Set dbVar = CurrentDb()
With dbVar.TableDefs
    Call .Delete(strTableName)
    Call .Refresh()
End With

When you delete tables through your interface the table is only really gone from your view. It still exists in the database, with a new name like the one you have, until the database goes through a Compact & Repair process. It's still held in the TableDefs collection till then.

[Petrol]

Many thanks for all that, NeoPa. It will take me a while to absorb it! ... but I'll work on my other post, about images, (and thanks also for the reply to that) first.

[NeoPa]

All good. I'm keen to hear how you get on with it :-)

[Petrol]

OK. thanks again for your help. All good now.
(I was a bit daunted at first by the sight of 70+ lines of code to replace my half dozen :-), but once I figured them out they were quite instructive in several ways - and they helped me debug my half dozen!)

[NeoPa]

Hi Petrol.

Yeah. The two extra procedures are simply what I use for convenience, and they take up the majority of the 77 lines. The main logic is in the RelinkTable() procedure and that only has as many as 35 due to my style of continuing lines rather than going beyond column #80. MultiReplace() is one I couldn't do without though. Once you start using it in earnest you realise why.

I didn't include my Scramble() routine for encrypting and decrypting passwords but you're welcome to send me a PM for it if you're interested. It's not ultra secure but it's a way beyond basic. I don't publish it to avoid giving any malicious readers the opportunity to disect and crack it. Otherwise I'm happy to share it though.

Petrol:
once I figured them out they were quite instructive in several ways - and they helped me debug my half dozen!

That's the best news of all. Anyone can use code. Understanding what it does and using that understanding elsewhere is where the benefits really come in. Good for you :-)