Another post on Automating Linked Table Manager - sorry!

[JodiPhillips]

Hi,

My first post! I've basically taught myself Access and the little I know about VBA through reading these forums and a couple of books.

I'm in the middle of a project at work - to put it mildly I've been thrown in at the deep end, in the past I've just done simple databases and that's been fine. Now, however I have to "roll out" various front ends to a single back end for initially 10 users (and the bosses have plans for this to go to all 100 users - I think this is a little ambitious for me and they may have to get a professional to do it). We don't have developers or systems admins that I can go to for help, I'm it basically. Each user has the host drive (where both the front end and a hidden back end lives) mapped to different drive letters (not sure if I can convince them to remap to a constant - but it may come down to me doing it, or if anyone knows of .bat that I can script, borrow, beg, pay a pittance for that can automagically shift an existing mapped drive to some other drive letter and map my shared drive to a constant letter?).

The training for our office is in a training db, and managers get a snapshot (query based for their staff) on a form (which serves as their front end). The manager's front end does not have every table that exists in the backend, only those needed for any form/query ie. just the participation table, course details table, and a few others for some other queries. (these tables are the same as those in the backend re structure and data and are linked on my drive).

One thread in particular I've been reading with interest lately http://www.thescripts.com/forum/thre...matically.html. I apologise for yet another post on this topic, but didn't want to hijack Bubbles thread.

My problem is similar to that in the above post - except I want the user to run an automated link table manager procedure after clicking a button.

At the moment I have a form with a macro attached to a custom command button. The macro is a TransferDatabas e action. On the click event the macro runs BUT I get an error no matter what I do that says the object isnt found, or the file doesn't exist, or the path is wrong. (I've triple checked spellings, UNC's and am happy that there are no typo's).

My action arguments are:
Transfer Type: Link
Database Type: Microsoft Access
Database Name:\\JodiShar e\Training\mana ger.mdb
Object Type: Table (left this as default it's ignored anyway with Transfer Type = Link
Source:\\Jodi\T raining\Trainin g_be.mdb
Destination:\\J odi\Training\ma nager.mdb (same as Database name)

Can anyone see anything wrong with what I have?

Any help at all is really appreciated - even if its just pointing me to a book or reference that I can research for this question.

Cheers

Jodi

[JodiPhillips]

Oops forgot to say MS Access 2003. =(

[MMcCarthy]

This is a simple routine that will allow you to select the backend manually.

Dim td As DAO.TableDef
Dim strFileName As String
Dim dlgPick As FileDialog
 
Set dlgPick = Application.FileDialog(msoFileDialogFilePicker)
 
dlgPick.AllowMultiSelect = False
dlgPick.Title = "Browse for the JobCardXP_be.mdb files please."
 
If dlgPick.Show = -1 Then
    strFileName = dlgPick.SelectedItems(1)
End If
 
For Each td In CurrentDb.TableDefs
  If Len(td.Connect) > 0 Then
     td.Connect = ";DATABASE=" & strFileName
     td.RefreshLink
  End If
Next
 

[MMcCarthy]

An this is a more complicated routine written by Dev Ashish.

' 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 tdf As TableDef
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
 
    Set dbCurr = CurrentDb
 
    'First get all linked tables in a collection
 
    dbCurr.TableDefs.Refresh
    For Each tdf In dbCurr.TableDefs
        With tdf
            If Len(.Connect) > 0 Then
                    collTables.Add Item:=.Name & .Connect, Key:=.Name
            End If
        End With
    Next
 
    Set tdf = Nothing
 
    strNewPath = "Data.mdb"
    For i = collTbls.Count To 1 Step -1
        strDBPath = Right((collTbls(i)), Len((collTbls(i))) - (InStr(1, (collTbls(i)), "DATABASE=") + 8))
        strTbl = Left$(collTbls(i), InStr(1, collTbls(i), ";") - 1)
        varRet = SysCmd(acSysCmdSetStatus, "Now linking '" & strTbl & "'....")
 
        strDBPath = strNewPath
        Set dbLink = DBEngine(0).OpenDatabase(strDBPath)
 
        'check to see if the table is present in dbLink
        strTbl = Left$(collTbls(i), InStr(1, collTbls(i), ";") - 1)
        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
    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
 

[JodiPhillips]

Wow! Thank you very, very much mmccarthy! I'll give both a go, though I think the first one should be sufficient. Will let you know how I go.

BTW was this code already on the board somewhere?

One day I hope to be able to write code like this =) .... one day.

[MMcCarthy]

Wow! Thank you very, very much mmccarthy! I'll give both a go, though I think the first one should be sufficient. Will let you know how I go.

BTW was this code already on the board somewhere?

One day I hope to be able to write code like this =) .... one day.

You're welcome.

This code is probably here somewhere. Unfortunately, the forum specific search is not working at the moment. Hopefully it will be fixed by the end of the week.

[JodiPhillips]

Quick update:

mmccarthy, I went with the first (smaller) code and everyone is happy with that!! Though I didn't end up using Dev Ashish's script I am working my way through it line by line and learning a LOT!

Thanks again.

Jodi

[MMcCarthy]

Quick update:

mmccarthy, I went with the first (smaller) code and everyone is happy with that!! Though I didn't end up using Dev Ashish's script I am working my way through it line by line and learning a LOT!

Thanks again.

Jodi

Glad to hear it.

Mary :)