Aide VBA : Attacher des tables basées sur des données externes (ODBC)
eve75013
Messages postés
2
Date d'inscription
lundi 12 décembre 2005
Statut
Membre
Dernière intervention
12 décembre 2005
-
12 déc. 2005 à 10:29
angenoir3000 Messages postés 4 Date d'inscription mardi 29 avril 2003 Statut Membre Dernière intervention 7 mars 2006 - 7 mars 2006 à 10:50
angenoir3000 Messages postés 4 Date d'inscription mardi 29 avril 2003 Statut Membre Dernière intervention 7 mars 2006 - 7 mars 2006 à 10:50
1 réponse
angenoir3000
Messages postés
4
Date d'inscription
mardi 29 avril 2003
Statut
Membre
Dernière intervention
7 mars 2006
7 mars 2006 à 10:50
7 mars 2006 à 10:50
La fonction suivante t'aideras mais attention elle extrait les données pour l'attachement des tables d'une table zMappage, il faudra donc l'adapter à ton problème: au lieu de boucler sur le recordset, boucle sur une liste des tables à attacher par exmple, si tu veux utiliser ma méthode il te faudra remplir une table zMappage.
Les connexions fonctionnent pour les 4 types de bases de données: MySQL, Oracle, AS400 et Access
Public Function XLDB_CreateODBCLinkedTables() As Boolean
Dim db As Database, rs As Recordset, tbl As TableDef
Dim ws As Workspace
Dim strConnect As String
On Error GoTo Errorhandler
XLDB_CreateODBCLinkedTables = False
'On crée les tables dans un autre Workspace que celui utilisé
' par les utilisateurs afin d'empêcher que ceux appartenant au
' groupe PWRead n'aient tous les droits. On crée ces tables avec
' l'utilisateur "PWUserAdmin", qui n'appartient évidemment
' pas au groupe PWRead.
Set ws = DBEngine.CreateWorkspace("wkPourLiaisonTables", "admin", "")
Set db = ws.OpenDatabase(CurrentDb.Name, False, False)
Set rs = db.OpenRecordset("select * from zMappageTables")
With rs
While Not .EOF
DoEvents
If rs!TypeDB = "MySQL" Then
If G_B_DB_TEST Then
strConnect = "ODBC;DSN=" & rs!dsn & "_test;SERVER=" & G_STR_SERVEUR_MYSQL & ";DATABASE=" & rs!NomDB & "_test;UID=" & G_STR_MYSQL_USER & ";PWD=" & G_STR_MYSQL_PWD & ";OPTION=" & G_STR_OPTION & ";"
Else
strConnect = "ODBC;DSN=" & rs!dsn & ";SERVER=" & G_STR_SERVEUR_MYSQL & ";DATABASE=" & rs!NomDB & ";UID=" & G_STR_MYSQL_USER & ";PWD=" & G_STR_MYSQL_PWD & ";OPTION=" & G_STR_OPTION & ";"
End If
ElseIf rs!TypeDB = "Oracle" Then
strConnect = "ODBC;DSN=" & rs!dsn & ";SERVER=" & G_STR_SERVEUR_ORACLE & ";UID=" & G_STR_ORACLE_USER & ";PWD=" & G_STR_ORACLE_PWD & ";"
ElseIf rs!TypeDB = "AS400" Then
strConnect = "ODBC;DSN=" & rs!dsn & ";UID=" & G_STR_AS400_USER & ";PWD=" & G_STR_AS400_PWD & ";"
ElseIf rs!TypeDB = "Access" Then
If rs!NomTableAccess = "zLog" Then
If G_B_DB_TEST Then
strConnect = "DATABASE=D:\Weidemann\Projets\MySofazImport\Programmes\DBLog.mdb"
Else
strConnect = "DATABASE=//s136a001/mysofazimport/DBLog.mdb"
End If
End If
End If
If (XLDB_DoesTblExist(rs!NomTableAccess) = False) Then
'Si la table n'existe pas on crée la liaison
If rs!NomTableAccess <> "zLog" Then
Set tbl = db.CreateTableDef(rs!NomTableAccess, dbAttachSavePWD)
Else
Set tbl = db.CreateTableDef(rs!NomTableAccess)
End If
tbl.Connect = strConnect
tbl.SourceTableName = rs!NomTableOrigine
db.TableDefs.Append tbl
Else
'Si la table liée existe déjà on réactualise le lien
Set tbl = db.TableDefs(rs!NomTableAccess)
tbl.Connect = strConnect
If rs!NomTableAccess <> "zLog" Then
tbl.Attributes = dbAttachSavePWD
End If
tbl.RefreshLink
End If
Debug.Print tbl.SourceTableName & " : " & tbl.Connect
rs.MoveNext
Wend
End With
'On masque les tables dans cette fonction car pour cela il faut des droits
' d'écriture (quand l'utilisateur appartient à PWRead cela est utile)
Set tbl = Nothing
For Each tbl In db.TableDefs
'On recherche les tables liées par ODBC en procédant à une addition
' binaire (la propriété Attributes est l'addition binaire de plusieurs propriétés)
If (tbl.Attributes And dbAttachedODBC) Then
'tbl.Attributes = dbHiddenObject
End If
Next
Set tbl = Nothing
db.Close
Set db = Nothing
ws.Close
Set ws = Nothing
Application.RefreshDatabaseWindow
'Call AfficherTables
XLDB_CreateODBCLinkedTables = True
End_F:
Exit Function
Errorhandler:
MsgBox "Function: CreateODBCLinkedTables" & Chr(13) & "Error: " & err.Number & Chr(13) & "Description: " & err.Description & Chr(13) & "Source: " & err.Source, vbCritical, "MyApp"
Resume End_F
End Function
Les connexions fonctionnent pour les 4 types de bases de données: MySQL, Oracle, AS400 et Access
Public Function XLDB_CreateODBCLinkedTables() As Boolean
Dim db As Database, rs As Recordset, tbl As TableDef
Dim ws As Workspace
Dim strConnect As String
On Error GoTo Errorhandler
XLDB_CreateODBCLinkedTables = False
'On crée les tables dans un autre Workspace que celui utilisé
' par les utilisateurs afin d'empêcher que ceux appartenant au
' groupe PWRead n'aient tous les droits. On crée ces tables avec
' l'utilisateur "PWUserAdmin", qui n'appartient évidemment
' pas au groupe PWRead.
Set ws = DBEngine.CreateWorkspace("wkPourLiaisonTables", "admin", "")
Set db = ws.OpenDatabase(CurrentDb.Name, False, False)
Set rs = db.OpenRecordset("select * from zMappageTables")
With rs
While Not .EOF
DoEvents
If rs!TypeDB = "MySQL" Then
If G_B_DB_TEST Then
strConnect = "ODBC;DSN=" & rs!dsn & "_test;SERVER=" & G_STR_SERVEUR_MYSQL & ";DATABASE=" & rs!NomDB & "_test;UID=" & G_STR_MYSQL_USER & ";PWD=" & G_STR_MYSQL_PWD & ";OPTION=" & G_STR_OPTION & ";"
Else
strConnect = "ODBC;DSN=" & rs!dsn & ";SERVER=" & G_STR_SERVEUR_MYSQL & ";DATABASE=" & rs!NomDB & ";UID=" & G_STR_MYSQL_USER & ";PWD=" & G_STR_MYSQL_PWD & ";OPTION=" & G_STR_OPTION & ";"
End If
ElseIf rs!TypeDB = "Oracle" Then
strConnect = "ODBC;DSN=" & rs!dsn & ";SERVER=" & G_STR_SERVEUR_ORACLE & ";UID=" & G_STR_ORACLE_USER & ";PWD=" & G_STR_ORACLE_PWD & ";"
ElseIf rs!TypeDB = "AS400" Then
strConnect = "ODBC;DSN=" & rs!dsn & ";UID=" & G_STR_AS400_USER & ";PWD=" & G_STR_AS400_PWD & ";"
ElseIf rs!TypeDB = "Access" Then
If rs!NomTableAccess = "zLog" Then
If G_B_DB_TEST Then
strConnect = "DATABASE=D:\Weidemann\Projets\MySofazImport\Programmes\DBLog.mdb"
Else
strConnect = "DATABASE=//s136a001/mysofazimport/DBLog.mdb"
End If
End If
End If
If (XLDB_DoesTblExist(rs!NomTableAccess) = False) Then
'Si la table n'existe pas on crée la liaison
If rs!NomTableAccess <> "zLog" Then
Set tbl = db.CreateTableDef(rs!NomTableAccess, dbAttachSavePWD)
Else
Set tbl = db.CreateTableDef(rs!NomTableAccess)
End If
tbl.Connect = strConnect
tbl.SourceTableName = rs!NomTableOrigine
db.TableDefs.Append tbl
Else
'Si la table liée existe déjà on réactualise le lien
Set tbl = db.TableDefs(rs!NomTableAccess)
tbl.Connect = strConnect
If rs!NomTableAccess <> "zLog" Then
tbl.Attributes = dbAttachSavePWD
End If
tbl.RefreshLink
End If
Debug.Print tbl.SourceTableName & " : " & tbl.Connect
rs.MoveNext
Wend
End With
'On masque les tables dans cette fonction car pour cela il faut des droits
' d'écriture (quand l'utilisateur appartient à PWRead cela est utile)
Set tbl = Nothing
For Each tbl In db.TableDefs
'On recherche les tables liées par ODBC en procédant à une addition
' binaire (la propriété Attributes est l'addition binaire de plusieurs propriétés)
If (tbl.Attributes And dbAttachedODBC) Then
'tbl.Attributes = dbHiddenObject
End If
Next
Set tbl = Nothing
db.Close
Set db = Nothing
ws.Close
Set ws = Nothing
Application.RefreshDatabaseWindow
'Call AfficherTables
XLDB_CreateODBCLinkedTables = True
End_F:
Exit Function
Errorhandler:
MsgBox "Function: CreateODBCLinkedTables" & Chr(13) & "Error: " & err.Number & Chr(13) & "Description: " & err.Description & Chr(13) & "Source: " & err.Source, vbCritical, "MyApp"
Resume End_F
End Function
