By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
440,581 Members | 1,975 Online
Bytes IT Community

Home Questions Articles Browse Topics Latest Top Members FAQ

home > topics > microsoft access / vba > questions > problem trying to relink back end
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 440,581 IT Pros & Developers. It's quick & easy.

Problem trying to relink back end

P: 99
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
Expand|Select|Wrap|Line Numbers
  1. strConnect = "MS Access;PWD=xxx;DATABASE=K:\Emmaus BS testdata_be.accdb"
  2. For Each tbl In CurrentDb.TableDefs
  3.     If InStr(tbl.Connect, Currently) > 0 Then              ' i.e. if it is a linked table (they all are, usually!)
  4.         TableName = tbl.Name & " table: "                  ' Extract table name for possible error message
  5.         tbl.Connect = strConnect                           ' same connect string for all linked tables
  6.     End If
  7. 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
Expand|Select|Wrap|Line Numbers
  1. 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.
2 Weeks Ago #1

✓ answered by 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()
Expand|Select|Wrap|Line Numbers
  1. Public Const conConnect As String = "MS Access;PWD=%P;DATABASE=%D"
  2. 'RelinkTables() ensures that all Jet-linked tables currently linked to
  3. '  strOldPath will be relinked to strNewPath.
  4. Public Function RelinkTables(ByVal strOldPath As String _
  5.                            , ByVal strNewPath As String _
  6.                            , ByVal strPW As String _
  7.                            , Optional ByRef dbVar As DAO.Database _
  8.                            , Optional ByVal blnPW As Boolean = True) As Integer
  9.     Dim tdfVar As DAO.TableDef
  10.  
  11.     On Error Resume Next
  12.     If strNewPath = strOldPath Then Exit Function
  13.     If Not Exist(strNewPath) Then Exit Function
  14.     If dbVar Is Nothing Then Set dbVar = CurrentDb()
  15.     For Each tdfVar In dbVar.TableDefs
  16.         Call Err.Clear
  17.         With tdfVar
  18.             If (.Attributes And dbAttachedTable) Then
  19.                 If InStr(1, .Connect, strOldPath) > 0 Then
  20.                     If blnPW Then
  21.                         .Connect = MultiReplace(conConnect _
  22.                                               , "%P", Scramble(strPW) _
  23.                                               , "%D", strNewPath)
  24.                     Else
  25.                         .Connect = MultiReplace(conConnect _
  26.                                               , "MS Access;PWD=%P", "" _
  27.                                               , "%D", strNewPath)
  28.                     End If
  29.                     Call .RefreshLink
  30.                     If Err = 0 Then RelinkTables = RelinkTables + 1
  31.                 End If
  32.             End If
  33.         End With
  34.     Next tdfVar
  35. End Function
Expand|Select|Wrap|Line Numbers
  1. 'Exist() returns true if strFile exists.  By default ignores folders.
  2. '22/05/2003 Rewritten with better code.
  3. '20/05/2005 Added finding of R/O, System & Hidden files.
  4. '11/12/2012 Added handling of inaccessible drives.
  5. '22/05/2013 Added code to avoid false positives for folders.
  6. Public Function Exist(ByVal strFile As String _
  7.                     , Optional intAttrib As Integer = vbReadOnly _
  8.                                                    Or vbHidden _
  9.                                                    Or vbSystem) As Boolean
  10.     On Error Resume Next
  11.     'Strip trailing "\" characters as this gives a false reading.
  12.     If Right(strFile, 1) = "\" Then strFile = Left(strFile, Len(strFile) - 1)
  13.     Exist = (Dir(PathName:=strFile, Attributes:=intAttrib) <> "")
  14. End Function
Expand|Select|Wrap|Line Numbers
  1. 'MultiReplace() takes each pair of parameters from avarArgs() and replaces the
  2. '  first with the second wherever found in strMain.
  3. 'Using VbBinaryCompare means that case is recognised and not ignored.
  4. '08/05/2013 Updated to support passing of an array directly into avarArgs.
  5. Public Function MultiReplace(ByRef strMain As String _
  6.                            , ParamArray avarArgs() As Variant) As String
  7.     Dim intX As Integer
  8.     Dim avarVals() As Variant
  9.  
  10.     'Code to handle avarArgs passed as an existing array.
  11.     If (UBound(avarArgs) = LBound(avarArgs)) _
  12.     And IsArray(avarArgs(LBound(avarArgs))) Then
  13.         ReDim avarVals(LBound(avarArgs) To UBound(avarArgs(LBound(avarArgs))))
  14.         For intX = LBound(avarVals) To UBound(avarVals)
  15.             avarVals(intX) = avarArgs(LBound(avarArgs))(intX)
  16.         Next intX
  17.     Else
  18.         avarVals = avarArgs
  19.     End If
  20.     If (UBound(avarVals) - LBound(avarVals)) Mod 2 = 0 Then Stop
  21.     MultiReplace = strMain
  22.     For intX = LBound(avarVals) To UBound(avarVals) Step 2
  23.         MultiReplace = Replace(Expression:=MultiReplace, _
  24.                                Find:=Nz(avarVals(intX), ""), _
  25.                                Replace:=Nz(avarVals(intX + 1), ""), _
  26.                                Compare:=vbBinaryCompare)
  27.     Next intX
  28. End Function
NB. It works just as well for ACE as for Jet (-linked tables).

Share this Question
Share on Google+
7 Replies
NeoPa
Expert Mod 15k+
P: 31,561
The missing link here is :
Expand|Select|Wrap|Line Numbers
  1. Call tbl.RefreshLink()
Give me 5 mins & I'll dig up a module for you that may be helpful.
1 Week Ago #2
NeoPa
Expert Mod 15k+
P: 31,561
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()
Expand|Select|Wrap|Line Numbers
  1. Public Const conConnect As String = "MS Access;PWD=%P;DATABASE=%D"
  2. 'RelinkTables() ensures that all Jet-linked tables currently linked to
  3. '  strOldPath will be relinked to strNewPath.
  4. Public Function RelinkTables(ByVal strOldPath As String _
  5.                            , ByVal strNewPath As String _
  6.                            , ByVal strPW As String _
  7.                            , Optional ByRef dbVar As DAO.Database _
  8.                            , Optional ByVal blnPW As Boolean = True) As Integer
  9.     Dim tdfVar As DAO.TableDef
  10.  
  11.     On Error Resume Next
  12.     If strNewPath = strOldPath Then Exit Function
  13.     If Not Exist(strNewPath) Then Exit Function
  14.     If dbVar Is Nothing Then Set dbVar = CurrentDb()
  15.     For Each tdfVar In dbVar.TableDefs
  16.         Call Err.Clear
  17.         With tdfVar
  18.             If (.Attributes And dbAttachedTable) Then
  19.                 If InStr(1, .Connect, strOldPath) > 0 Then
  20.                     If blnPW Then
  21.                         .Connect = MultiReplace(conConnect _
  22.                                               , "%P", Scramble(strPW) _
  23.                                               , "%D", strNewPath)
  24.                     Else
  25.                         .Connect = MultiReplace(conConnect _
  26.                                               , "MS Access;PWD=%P", "" _
  27.                                               , "%D", strNewPath)
  28.                     End If
  29.                     Call .RefreshLink
  30.                     If Err = 0 Then RelinkTables = RelinkTables + 1
  31.                 End If
  32.             End If
  33.         End With
  34.     Next tdfVar
  35. End Function
Expand|Select|Wrap|Line Numbers
  1. 'Exist() returns true if strFile exists.  By default ignores folders.
  2. '22/05/2003 Rewritten with better code.
  3. '20/05/2005 Added finding of R/O, System & Hidden files.
  4. '11/12/2012 Added handling of inaccessible drives.
  5. '22/05/2013 Added code to avoid false positives for folders.
  6. Public Function Exist(ByVal strFile As String _
  7.                     , Optional intAttrib As Integer = vbReadOnly _
  8.                                                    Or vbHidden _
  9.                                                    Or vbSystem) As Boolean
  10.     On Error Resume Next
  11.     'Strip trailing "\" characters as this gives a false reading.
  12.     If Right(strFile, 1) = "\" Then strFile = Left(strFile, Len(strFile) - 1)
  13.     Exist = (Dir(PathName:=strFile, Attributes:=intAttrib) <> "")
  14. End Function
Expand|Select|Wrap|Line Numbers
  1. 'MultiReplace() takes each pair of parameters from avarArgs() and replaces the
  2. '  first with the second wherever found in strMain.
  3. 'Using VbBinaryCompare means that case is recognised and not ignored.
  4. '08/05/2013 Updated to support passing of an array directly into avarArgs.
  5. Public Function MultiReplace(ByRef strMain As String _
  6.                            , ParamArray avarArgs() As Variant) As String
  7.     Dim intX As Integer
  8.     Dim avarVals() As Variant
  9.  
  10.     'Code to handle avarArgs passed as an existing array.
  11.     If (UBound(avarArgs) = LBound(avarArgs)) _
  12.     And IsArray(avarArgs(LBound(avarArgs))) Then
  13.         ReDim avarVals(LBound(avarArgs) To UBound(avarArgs(LBound(avarArgs))))
  14.         For intX = LBound(avarVals) To UBound(avarVals)
  15.             avarVals(intX) = avarArgs(LBound(avarArgs))(intX)
  16.         Next intX
  17.     Else
  18.         avarVals = avarArgs
  19.     End If
  20.     If (UBound(avarVals) - LBound(avarVals)) Mod 2 = 0 Then Stop
  21.     MultiReplace = strMain
  22.     For intX = LBound(avarVals) To UBound(avarVals) Step 2
  23.         MultiReplace = Replace(Expression:=MultiReplace, _
  24.                                Find:=Nz(avarVals(intX), ""), _
  25.                                Replace:=Nz(avarVals(intX + 1), ""), _
  26.                                Compare:=vbBinaryCompare)
  27.     Next intX
  28. End Function
NB. It works just as well for ACE as for Jet (-linked tables).
1 Week Ago #3
NeoPa
Expert Mod 15k+
P: 31,561
Expand|Select|Wrap|Line Numbers
  1. 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.
Expand|Select|Wrap|Line Numbers
  1. Dim strTableName As String
  2. Dim dbVar As DAO.Database
  3.  
  4. strTableName = "~TMPCLP191411"
  5. If dbVar Is Nothing Then Set dbVar = CurrentDb()
  6. With dbVar.TableDefs
  7.     Call .Delete(strTableName)
  8.     Call .Refresh()
  9. 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.
1 Week Ago #4
P: 99
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.
1 Week Ago #5
NeoPa
Expert Mod 15k+
P: 31,561
All good. I'm keen to hear how you get on with it :-)
1 Week Ago #6
P: 99
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!)
1 Week Ago #7
NeoPa
Expert Mod 15k+
P: 31,561
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 :-)
1 Week Ago #8

Post your reply

Sign in to post your reply or Sign up for a free account.

Question stats

  • viewed: 649
  • replies: 7
  • date asked: 2 Weeks Ago
BYTES.COM © 2019 About Bytes | Advertise on Bytes | Privacy Policy | Manage Cookies
Sitemap | Microsoft Access / VBA Answers Sitemap | Microsoft Access / VBA Insights Sitemap

Follow us to get the Latest Bytes Updates