Gestion des liens pour tables attachées

Commenter

Contenu du snippet

Permet de créer une table "Connection" contenant le nom et le lien de connection de chaque table attachée.
commande : CONNECTION 1
ou
Permet de modifier quand vous voulez pour une ou toutes les tables attachées
- la base de données
- le mot de passe
- la chaine de connection
et de refaire la connection automatiquement si les nouvelles informations sont valides
commande : connection 2,,"database","//server/repertoire/sous-rep/x.mdb"
ou
commande : connection 2,,"psw","nouveau mot de passe"

Source / Exemple : 


vous devez ajouter la référence : Windows DAO 3.51 Object Library, ou supérieure au projet
-------
vous devez avoir définit une variable publique dans les déclarations d'un module
Public cnndb As dao.Database
-------
Public Sub Connection(Options As Integer, Optional Table As String, Optional Champ As String, Optional data As String)
Dim tdf As TableDef
Dim indx As Index
Dim rst As dao.Recordset
Dim x As Integer

On Error GoTo Conn_Err
Select Case Options
    Case 1  'Lecture
        cnndb.Execute "delete * from connection;"
        Set rst = cnndb.OpenRecordset("connection")
        For Each tdf In cnndb.TableDefs
            If (tdf.Attributes And dbAttachedTable) = dbAttachedTable Then
                rst.AddNew
                rst!Name = tdf.Name
                rst!Connect = tdf.Connect
                rst.Update
            End If
        Next
        rst.Close
    Case 2  'Modifications
        Set rst = cnndb.OpenRecordset("connection", dbOpenDynaset)
            For Each tdf In cnndb.TableDefs
                If (tdf.Attributes And dbAttachedTable) = dbAttachedTable Then
                    If Table = "*" Or Table = "" Or IsNull(Table) Then
                        rst.FindFirst "[name] = '" & tdf.Name & "'"
                    Else
                        rst.FindFirst "[name] = '" & Table & "'"
                    End If
                    If rst.NoMatch = False Then
                        rst.Edit
                        Select Case LCase(Champ)
                            Case "database"
                                x = InStr(1, rst!Connect, "database=", vbTextCompare)
                                If x = 0 Then
                                    If data <> "" Then rst!Connect = rst!Connect & "DATABASE=" & data
                                Else
                                    If data <> "" Then rst!Connect = Left(rst!Connect, x - 1) & "DATABASE=" & data
                                End If
                            Case "pwd"
                                x = InStr(1, rst!Connect, "pwd=", vbTextCompare)
                                If x = 0 Then
                                    If data <> "" Then rst!Connect = "MS Access;PWD=" & data & rst!Connect
                                Else
                                    If data <> "" Then
                                        rst!Connect = Left(rst!Connect, x + 4) & data & Right(rst!Connect, InStr(x, rst!Connect, ";", vbTextCompare))
                                    Else
                                        rst!Connect = ";" & Right(rst!Connect, Len(rst!Connect) - InStr(1, rst!Connect, ";", vbTextCompare))
                                    End If
                                End If
                        End Select
                        cnndb.TableDefs(tdf.Name).Connect = rst!Connect
                        cnndb.TableDefs(tdf.Name).RefreshLink
                        rst.Update
                    End If
                End If
            Next
        rst.Close
End Select
Set rst = Nothing
Exit Sub

Conn_Err:
Select Case Err.Number
    Case 3078
        Set tdf = cnndb.CreateTableDef("connection")
        With tdf
            .Fields.Append .CreateField("name", dbText, 50)
            .Fields.Append .CreateField("connect", dbText, 250)
        End With
        cnndb.TableDefs.Append tdf
        Set indx = tdf.CreateIndex("PrimaryKey")
        indx.Fields.Append indx.CreateField("name")
        indx.Primary = True
        indx.Unique = True
        tdf.Indexes.Append indx
        Resume
    Case Else
        MsgBox Err.Number & " = " & Err.Description
End Select
End Sub

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_gandalf27)