Public Const fForm = "Forms"
Public Const fReport = "Reports"
Public Const fMacro = "Scripts"
Public Const fModulo = "Modules"
Public Const fTabella = "Tables"
Public Const fQuery = "Queries"

Private Const cLnkTbl As String = "_LinkedTables"

Private Function LinkTbl() As Boolean
   On Error GoTo Err_LinkTbl
   Dim rs As DAO.Recordset
   Dim strSQL As String
   Dim dbCurr As DAO.Database
   Dim S As String
   LinkTbl = False
   Set dbCurr = CurrentDb
   strSQL = cLnkTbl
   dbCurr.TableDefs.Refresh
   Set rs = CurrentDb.OpenRecordset(strSQL)
   rs.MoveFirst
   Do Until rs.EOF
      S = rs.Fields(0).value
      If Esiste_Oggetto(S, fTabella) Then _
            CurrentDb.TableDefs.Delete S
      DoCmd.TransferDatabase acLink, "Microsoft Access", _
      mPathBE, acTable, S, S
      rs.MoveNext
   Loop
   LinkTbl = True
Exit_Here:
   rs.Close
   Set rs = Nothing
   Exit Function
Err_LinkTbl:
   LinkTbl = False
   MsgBox "Impossibile connettersi al Server"
   Resume Exit_Here
End Function


Public Function Esiste_Oggetto(ByVal Nome_Ogg As String, _
                               Typ_Ogg As String, Optional ByVal Nome_Dbs As String = "") As Boolean
'*****************************************************************
'Name      : Esiste_Oggetto (Function)
'Purpose   : Verifie if Database Object(Table, Query, Form or ...) Exist
'Author    : Alessandro Baraldi
'Web_Site  : http://digilander.iol.it/ik2zok/
'E.Mail    : ik2zok@libero.it
'Date      : 23 gennaio 2002
'Called by :
'Calls     :
'Inputs    : String=Object Name
'          : Type="Tables" or "Forms" or "Queries"
'          :      "Scripts" or "Reports" or "Modules"
'          : Nome_Dbs=Database.mdb (Source where Function search)
'Output    : True if Object Exist
'*****************************************************************
   Dim dbs As Database
   Dim tdf As TableDef
   Dim qdf As QueryDef
   Dim X, num_ogg As Integer
   If Nome_Dbs = "" Then
      Set dbs = CurrentDb
   Else
      Set dbs = OpenDatabase(Nome_Dbs)
   End If
   Select Case Typ_Ogg
      Case fTabella
         For Each tdf In dbs.TableDefs
            If tdf.Name = Nome_Ogg Then
               Esiste_Oggetto = True
               dbs.Close
               Set dbs = Nothing
               Exit Function
            End If
         Next tdf
      Case fQuery
         For Each qdf In dbs.QueryDefs
            If qdf.Name = Nome_Ogg Then
               Esiste_Oggetto = True
               dbs.Close
               Set dbs = Nothing
               Exit Function
            End If
         Next qdf
      Case fForm, fModulo, fMacro, fReport
        num_ogg = dbs.Containers(Typ_Ogg).Documents.Count
        For X = 0 To num_ogg - 1
           If dbs.Containers(Typ_Ogg).Documents(X).Name = Nome_Ogg Then
             Esiste_Oggetto = True
             dbs.Close
             Set dbs = Nothing
             Exit Function
           End If
        Next
   End Select
Esci:
   Esiste_Oggetto = False
   dbs.Close
   Set dbs = Nothing
End Function


'*****************************************************************************************
********************  MODULO PER RIEMPIMENTO AUTOMATICO DELLA _LinkedTables  *************
'*****************************************************************************************


'*****************************************************************************************
'QUESTA ROUTINE SERVE SOLO A RIEMPIRE LA
'TABELLA LINKEDTABLE LA PRIMA VOLTA
'*****************************************************************************************
'Public Function FillTableName()

'  '_LinkedTable è da eliminare a mano.
'   Dim rs As DAO.Recordset
'   Dim rsTable As DAO.Recordset
'   Dim strSQL As String
'   CurrentDb.Execute "DELETE * FROM _LinkedTables;", dbFailOnError
'   strSQL = "SELECT MsysObjects.Name FROM MsysObjects " & _
'          "WHERE ((Left$([Name], 4) <> 'Msys') And (MsysObjects.Type = 6))"
'   Set rs = CurrentDb.OpenRecordset(strSQL, dbReadOnly)
'   Set rsTable = CurrentDb.OpenRecordset("_LinkedTables", dbOpenTable)
'   rs.MoveFirst
'   Do Until rs.EOF
'      rsTable.AddNew
'      rsTable.Fields(0) = rs.Fields(0)
'      rsTable.Update
'      rs.MoveNext
'   Loop
'   rs.Close
'   rsTable.Close
'   Set rs = Nothing
'   Set rsTable = Nothing
'End Function

Nota
Il codice VBA delle funzioni di cui sopra fa riferimento alla libreria Microsoft DAO quindi, se si usa una versione di Access successiva ad Access 97, verificare che il database abbia i riferimenti alla libreria Microsoft DAO 3.6 Object Library.