CISA FotoGallery

Statistiche

Tot. visite contenuti : 928221
Home Articoli tecnici Tabelle Relink ODBC Tables

Relink ODBC Tables

CODICE

'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 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 : 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

' Note
' CREARE una Tabella chiamata _LinkedTables con un campo
' di tipo testo adatto a contenere il nome delle Tabelle da Linkare
'***************************************************************************
'QUESTA ROUTINE SERVE SOLO A RIEMPIRE LA
'TABELLA LINKEDTABLE LA PRIMA VOLTA
'***************************************************************************
Public Function FillTableName()
    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