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 cCnnString as String="ODBC;DRIVER={SQL Server};SERVER=NOME_SERVER;UID=USER_NAME;PWD=PASSWORD;DATABASE=DB_NAME;LANGUAGE=Italiano;

Private Const cLnkTbl As String = "_LinkedTables"

Private Function LinkODBCTbl() As Boolean
   On Error GoTo Err_RlnkODBCTbl
   Dim tdf As DAO.TableDef
   Dim rs As DAO.Recordset
   Dim S As String
   Dim strSQL As String
   LinkODBCTbl = False
   strSQL = cLnkTbl
   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
      Set tdf = CurrentDb.CreateTableDef(S)
      tdf.Connect = cCnnString
      tdf.SourceTableName = S
      CurrentDb.TableDefs.Append tdf
      Set tdf = Nothing
      rs.MoveNext
   Loop
   LinkODBCTbl = True
Exit_Here:
   rs.Close
   Set rs = Nothing
   Set tdf = Nothing
   Exit Function
Err_RlnkODBCTbl:
   LinkODBCTbl = 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.