CISA FotoGallery

Statistiche

Tot. visite contenuti : 928226
Home Articoli tecnici Tabelle Relink Access Tables

Relink Access Tables

Inserire il Codice seguente in un Modulo ed eseguirlo all'Avvio

Serve predisporre una Tabella che chiameremo come nella dichiarazione della Const(cLnkTbl)="_LinkedTables" nella quale salvare tutti i nomi delle tabelle LINKATE


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 : Questo indirizzo e-mail è protetto dallo spam bot. Abilita Javascript per vederlo.
'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