[ACCESS] ATTACHER / DÉTACHER DES TABLES LIÉES access, liaison, table, password, attach, Source N°41570

Information sur la source

Catégorie :Base de Donnees Classé sous : access, liaison, table, password, attach Niveau : Débutant Date de création : 21/02/2007 Vu : 7 581

Auteur : pifou25

Ecrire un message privé

Note :
Aucune note

Commentaire sur cette source (0)

Ajouter un commentaire et/ou une note

Description

3 fonctions:
la 1ere (cas particulier des tables Access) permet de vérifier que le fichier access cible est bien disponible.

la 2eme supprime toutes les tables attachées.

la 3eme 'actualise' (en fait supprime et recrée) les tables définies dans un tableau. On lui donne en argument le fichier Acces source ainsi qu'un mot de passe s'il est protégé (c'est préférable).

Source

Public Function VerifAttach() As Boolean
Dim tdf As DAO.TableDef, strTemp As Variant, strPath As String, i As Long
For Each tdf In CurrentDb.TableDefs
' recherche d'une table liée
If tdf.Connect <> "" Then
strTemp = Split(tdf.Connect, ";")
For i = LBound(strTemp) To UBound(strTemp)
' recherche du paramètre de connection
If strTemp(i) Like "DATABASE=*" Then
strPath = Split(strTemp(i), "=")(1)
' vérification de l'existence de la bdd Coclico
If Dir(strPath) <> "" Then
Coclico_VerifAttach = True
Exit Function
End If
End If
Next i
End If
Next
End Function
Public Sub DeleteTables()
' supprimer toutes les tables attachées
On Error Resume Next
Dim db As DAO.Database 'Database to import
Dim tdf As DAO.TableDef
Dim arrTablename() As String, i As Long
ReDim arrTablename(0)
Set db = CurrentDb
' répertorier les tables à supprimer
For Each tdf In db.TableDefs
If tdf.Connect <> "" Then
ReDim Preserve arrTablename(UBound(arrTablename) + 1)
arrTablename(UBound(arrTablename)) = tdf.Name
End If
Next
' suppression
For i = LBound(arrTablename) To UBound(arrTablename)
db.TableDefs.Delete arrTablename(i)
Next i
Set db = Nothing
End Sub
Public Function ActualiserAttaches(ByVal strCheminBd As String, Optional ByVal strMotPasse As String = "") As Boolean
On Error GoTo ActualiserAttaches_Err
Dim tdf As DAO.TableDef
Dim arrTablename As Variant, arrSourceName As Variant, strSourceConnect As String, i As Long
arrTablename = Array("Activite", "RaisonSociale", "Region", "Site")
arrSourceName = Array("Activités", "Raison_sociale", "Region", "Site")
strSourceConnect = "MS Access;PWD=" & strMotPasse & ";DATABASE=" & strCheminBd
' supprimer les tables avant tout
DeleteTables
' créer les tables
For i = LBound(arrTablename) To UBound(arrTablename)
Set tdf = New TableDef
tdf.Name = arrTablename(i)
tdf.SourceTableName = arrSourceName(i)
tdf.Connect = strSourceConnect
CurrentDb.TableDefs.Append tdf
Next i
ActualiserAttaches = True
Exit Function
ActualiserAttaches_Err:
MsgBox "Error " & Err.Number & " (" & Err.Description & _
") in Function ActualiserAttaches of Module mdFonctions", vbCritical
End Function

Public Function VerifAttach() As Boolean
Dim tdf As DAO.TableDef, strTemp As Variant, strPath As String, i As Long

For Each tdf In CurrentDb.TableDefs
    ' recherche d'une table liée 
    If tdf.Connect <> "" Then
        strTemp = Split(tdf.Connect, ";")
        For i = LBound(strTemp) To UBound(strTemp)
            ' recherche du paramètre de connection
            If strTemp(i) Like "DATABASE=*" Then
                strPath = Split(strTemp(i), "=")(1)
                ' vérification de l'existence de la bdd Coclico
                If Dir(strPath) <> "" Then
                    Coclico_VerifAttach = True
                    Exit Function
                End If
            End If
        Next i
    End If
Next

End Function




Public Sub DeleteTables()
' supprimer toutes les tables attachées
On Error Resume Next

Dim db As DAO.Database  'Database to import
Dim tdf As DAO.TableDef
Dim arrTablename() As String, i As Long

ReDim arrTablename(0)
Set db = CurrentDb
' répertorier les tables à supprimer
For Each tdf In db.TableDefs
    If tdf.Connect <> "" Then
        ReDim Preserve arrTablename(UBound(arrTablename) + 1)
        arrTablename(UBound(arrTablename)) = tdf.Name
    End If
Next
' suppression
For i = LBound(arrTablename) To UBound(arrTablename)
    db.TableDefs.Delete arrTablename(i)
Next i
Set db = Nothing

End Sub



Public Function ActualiserAttaches(ByVal strCheminBd As String, Optional ByVal strMotPasse As String = "") As Boolean

On Error GoTo ActualiserAttaches_Err
Dim tdf As DAO.TableDef

Dim arrTablename As Variant, arrSourceName As Variant, strSourceConnect As String, i As Long
arrTablename = Array("Activite", "RaisonSociale", "Region", "Site")
arrSourceName = Array("Activités", "Raison_sociale", "Region", "Site")
strSourceConnect = "MS Access;PWD=" & strMotPasse & ";DATABASE=" & strCheminBd

' supprimer les tables avant tout
DeleteTables

' créer les tables
For i = LBound(arrTablename) To UBound(arrTablename)
    Set tdf = New TableDef
    tdf.Name = arrTablename(i)
    tdf.SourceTableName = arrSourceName(i)
    tdf.Connect = strSourceConnect
    CurrentDb.TableDefs.Append tdf
Next i
ActualiserAttaches = True
Exit Function

ActualiserAttaches_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & _
        ") in Function ActualiserAttaches of Module mdFonctions", vbCritical

End Function

Conclusion

Pour la dernière fonction (ActualiserAttaches) on aurait pu choisir de lister et attacher toutes les tables du fichier access sélectionné. Moi je n'en avait que 4 spécifiques à attacher que j'ai donc spécifié dans un tableau. De plus ça me permet de leur donner un nom différent que celui de la source.

Sinon le principe est le même pour lier une table via un paramètre ODBC, il suffit de connaitre les identifiants à renseigner dans la variable strSourceConnect. Je ne sais pas si on peut dans ce cas parcourir la liste des tables du serveur par contre.