Tables |
1.29 Riallegare tabelle ODBC |
Alessandro Baraldi |
Inserire il codice VBA seguente in un modulo standard del database ed eseguirlo all'Avvio, ad esempio tramite la macro Autoexec. 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 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. |