AccessTr.neT

Public Function Sql_RefreshTables()



    Dim TD As TableDef

    Dim S As String

    Dim IdxFlds As String



    DB.TableDefs.Refresh



    ' save current Indizes for Views (recreated after .RefreshLink)

    Call StoreViewPKs



    For Each TD In DB.TableDefs

        If Len(TD.Connect) > 0 Then

            If Left(TD.Connect, 5) = "ODBC;" Then



                Debug.Print "Updating " & TD.Name

                TD.Connect = ODBC_String()

                TD.RefreshLink



                ' View?

                If TD.Name Like "v_*" Then

                    IdxFlds = Nz(DLookup("IndexFields", "t_LinkedViewPK", "ViewName = '" & TD.Name & "'"))

                    If IdxFlds = "" Then Stop



                    ' Create PK

                    S = "CREATE INDEX PrimaryKey ON " & TD.Name & " (" & IdxFlds & ") WITH PRIMARY"

                    DB.Execute S

                End If



            End If

        End If

    Next TD



    DB.TableDefs.Refresh



End Function

Private Sub StoreViewPKs()



    Dim TD As TableDef

    Dim idx As index

    Dim FD As Field

    Dim RS As Recordset

    Dim S As String



    ' DB is a global Database object, set to CurrentDB

    DB.Execute "Delete * From t_LinkedViewPK"

    Set RS = DB.OpenRecordset("t_LinkedViewPK")



    For Each TD In DB.TableDefs

        If TD.Name Like "v_*" Then

            ' Views must have exactly one index. If not: panic!

            If TD.Indexes.Count <> 1 Then

                MsgBox "View " & TD.Name & " has " & TD.Indexes.Count & " Indizes.", vbCritical

                Stop

            End If



            Set idx = TD.Indexes(0)

            ' Build field list (the index may contain multiple fields)

            S = ""

            For Each FD In idx.Fields

                If S <> "" Then S = S & ", "

                S = S & FD.Name

            Next FD



            RS.AddNew

            RS!ViewName = TD.Name

            RS!IndexFields = S

            RS.Update

        End If

    Next TD



    RS.Close



End Sub

Private Sub insertIntoTable()

    On Error GoTo Err_hata



    Dim conn As ADODB.Connection

    

    Set conn = CreateObject("ADODB.Connection")

    conn.Open "DRIVER=SQLite3 ODBC Driver;Database=\\accessman\data\mrs.db;"



    If conn Is Nothing Then

       MsgBox "Bağlanılamadı"

    Else

        Dim strsql As String

        Dim cmd As ADODB.Command

        Dim Param, Param1 As ADODB.Parameter

        

        Set cmd = New ADODB.Command

        Set cmd.ActiveConnection = conn

              

        strsql = "CREATE TABLE tlite ENGINE=CONNECT TABLE_TYPE=ODBC tabname='tUser' CONNECTION='Driver=SQLite3 ODBC Driver;Database=\\accessman\data\mrs.db;NoWCHAR=yes' CHARSET=utf8 DATA_CHARSET=utf8;"

         

        cmd.CommandText = strsql



        cmd.Execute



    End If

    

    Set conn = Nothing



Exit_kod:

    Exit Sub



Err_hata:

    MsgBox Err.Description

    Resume Exit_kod

End Sub