backend and links questions

[clive2002]

Hi Guys,

Hope someone can help with the below.

I have a split database, with the backend saved on a network.

1) How can i retrieve the name and location of the backend in VBA?
2) Is it possible to change the linked location for each table via VBA, say for example if i wanted to switch the tables to point to a backup version of the backend, or if a user had different drive mapping on a there machine which meant that the table location had to be remapped.

I'm using access 2007.

Thanks
Clive

 

[dpw204]

Hi Guys,

Hope someone can help with the below.

I have a split database, with the backend saved on a network.

1) How can i retrieve the name and location of the backend in VBA?

I don't know about that one..

2) Is it possible to change the linked location for each table via VBA, say for example if i wanted to switch the tables to point to a backup version of the backend, or if a user had different drive mapping on a there machine which meant that the table location had to be remapped.
Clive

Yes.
One Example I've seen:

'source: http://www.fabalou.com/Access/Modules/refreshtables.asp
' minor revisions by dpw204
'Public Sub RelinkTables(NewPathname As String)
Public Sub RelinkTables()
    Dim NewPathname As String
    Dim dbs As Database
    Dim Tdf As TableDef
    Dim Tdfs As TableDefs
    Set dbs = CurrentDb
    Set Tdfs = dbs.TableDefs
  NewPathname = "\\dpwfsabc\data\db\permit\permitparking_be.mdb" ' UNC

Dim rsp, style As String
style = vbYesNo + vbCritical
rsp = MsgBox("This process will relink all tables to the following location:" _
              & vbNewLine & vbNewLine & NewPathname, _
              vbYesNo + vbExclamation, "Relink - Yes/No?")
              ' was: vbCritical
If rsp = vbNo Then
    Exit Sub
End If
'Loop through the tables collection
       For Each Tdf In Tdfs
     '  MsgBox ("Processing table: " & Tdf.SourceTableName) ' debug code
        If Tdf.SourceTableName <> "" Then 'If the table source is other than a base table
            Tdf.Connect = ";DATABASE=" & NewPathname 'Set the new source
         '  MsgBox ("string:" & Tdf.SourceTableName) ' debug line...
            Tdf.RefreshLink 'Refresh the link
        End If
    Next 'Goto next table
MsgBox ("Tables relinked to backend: " & NewPathname & _
         vbNewLine & " Verify: by: Menu 'Tools' | 'Database Utilities' | 'Linked Table Manager' " & _
        vbNewLine & "This will show the path to the linked tables.")
End Sub

 

[Red17]

I use the following on startup to relink tables in Access 2007 (assumes that the back-end database name is the same and that it is stored in the same directory as the front-end but this can be modified by passing a parameter to the RefreshTableLinks procedure).

Sub RefreshTableLinks()

Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim strTableName As String
Dim strTablePath As String
Dim strDBName As String
Dim strDBPath As String
Dim fso As New FileSystemObject

Set cat = New ADOX.Catalog

' Open the catalog.
cat.ActiveConnection = CurrentProject.Connection

Set tbl = New ADOX.Table

For Each tbl In cat.Tables
' Verify that the table is a linked table.
With tbl
If .Type = "LINK" Then
'Get existing link path for the table
strDBName = .Properties("Jet OLEDB:Link Datasource")
'Extract the back end db name from link path (assumes that the new link database will be the same name as existing db
strDBName = getFile(strDBName)
'Get the path of the current database (assumes that front end and back end
located in same directory as front end
'Could be set in code or passed to this procedure as a parameter
strDBPath = getPath
'Create new path for the table
strTablePath = Concat(strDBPath, "\", strDBName)

'Check if target db exists
If fso.FileExists(strTablePath) Then

'If target db exists, update table properties with new link path
.Properties("Jet OLEDB:Link Datasource") = strTablePath
' To refresh a linked table with a database password set the Link Provider
String
'.Properties("Jet OLEDB:Link Provider String") = "MS Access;PWD=Admin;"
Else
'Display message if target database not found
MsgBox Concat("Please make sure that ", strDBName, " is located in ", strDBPath), vbCritical, "Tables Not Found"
'Exit applicatiopn on db not found
DoCmd.Quit acQuitSaveNone
End If

End If
End With
Next

End Sub

Function getPath()
'Returns the path to currently opened MDB or ADP
GetPath = CurrentProject.path
End Function

Function getFile(Filename As String) As String
getFile = Mid(Filename, InStrRev(Filename, "\") + 1)
End Function

The line of code that finds the path for the existing linked db is:

strDBName = .Properties("Jet OLEDB:Link Datasource")

Hope this helps

 

[JANR]

1) How can i retrieve the name and location of the backend in VBA?

Mid(Currentdb.TableDefs("NameOfOneLinkedTable").Connect, 11)

Gives you the full path and name of your backend DB.

Here is a code I use to switch between my LiveDB and a trainerDB which ignores my other linked sources. It also keeps a persitant connection to the backend during the linking prosess to speed things up.

To call the function when I go from LIVE to Trainer:

Call fConnect("Trainer")

To go back online:

Call fConnect()

Option Compare Database
Option Explicit
 
Const ServerDB = "[URL="file://\\server\prog\DATABASE\InternBE.accdb"]\\server\prog\DATABASE\InternBE.accdb[/URL]"
Const TrainerDB = "[URL="file://\\server\prog\DATABASE\BEtmp.accdb"]\\server\prog\DATABASE\BEtmp.accdb[/URL]"
 
Function fConnect(Optional ConnectDB As String = "Live")
Dim tblDB As String
Dim tbl As DAO.TableDef
Dim Location As String
Dim tfConnected As Boolean
Dim rsTmp As DAO.Recordset
   On Error GoTo fConnect_Error
 
DoCmd.Hourglass True
If ConnectDB = "Live" Then
    Location = ServerDB
    tblDB = TrainerDB
Else
    Location = TrainerDB
    tblDB = ServerDB
End If
 
For Each tbl In CurrentDb.TableDefs
        If tbl.Attributes = dbAttachedTable Then
            If tbl.Connect = ";Database=" & tblDB Then
                tbl.Connect = ";Database=" & Location
                tbl.RefreshLink
                If tfConnected = False Then
                    tfConnected = True
                    Set rsTmp = CurrentDb().OpenRecordset(tbl.Name) 'persistant connection
                End If
            End If
        End If
    Next
 
Exitpoint:
Set rsTmp = Nothing
DoCmd.Hourglass False
On Error GoTo 0
Exit Function
 
fConnect_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure fConnect of Module basConnect"
    Resume Exitpoint
End Function

JR

 

[gemma-the-husky]

as janr said, the connect property (read/write) of the tabeldefs object is the key to this