Discussion :

[Fredo67]

Bonjour,
j'ai une requête dans ma base Access qui cherche des infos sur un serveur AS400.
Je passe par un lien ODBC configuré sur le poste de l'utilisateur.
Ma base étant utilisée par plusieurs personnes, je voudrais pouvoir tester la présence de la connexion ODBC sur le PC avant d'éxecuter ma mise à jour depuis l'AS400.

Existe il une astuce en VBA pour pouvoir tester cette condition ?

D'avance merci
Fred

[LedZeppII]

Bonsoir,

Je ne connais qu'un moyen qui consiste à lire la base de registre.
Pour 2000 et XP :
Les sources de données utilisateur sont dans
HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\ODBC Data Sources
Les sources de données système (tous les utilisateurs) sont dans
HKEY_LOCAL_MACHINE\Software\ODBC\ODBC.INI\ODBC Data Sources

Code vb :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Option Compare Database
Option Explicit
' Début de déclarations
Private Const HKCU = &H80000001  ' HKEY_CURRENT_USER (( HKEY ) 0x80000001 )
Private Const HKLM = &H80000002  ' HKEY_LOCAL_MACHINE(( HKEY ) 0x80000002 )
 
Private Const KEY_QUERY_VALUE As Long = &H1
 
Private Declare Function RegOpenKeyEx Lib "Advapi32.dll" Alias "RegOpenKeyExA" _
    (ByVal hKey As Long, ByVal sbKey As String, ByVal Options As Long, _
     ByVal Security As Long, ByRef newHKey As Long) As Long
 
 
Private Declare Function RegEnumValue Lib "Advapi32.dll" Alias "RegEnumValueA" _
    (ByVal hKey As Long, ByVal dwIndex As Long, _
     ByVal lpValueName As String, ByRef lpcValueName As Long, _
     ByVal lpReserved As Long, ByRef lpType As Long, _
     ByVal lpData As String, ByRef lpcbData As Long) As Long
 
Private Declare Function RegCloseKey Lib "Advapi32.dll" _
    (ByVal hKey As Long) As Long
 
Public Enum dsnTypes
        dsnUser = 0
        dsnSystem = 1
End Enum
' Fin des déclarations
 
Public Function VerifierDSN(strDSN, Optional dsnType As dsnTypes = dsnTypes.dsnuser) As String
Dim hKey As Long, lngRootKey As Long, strKey As String
Dim lngKeyType As Long, strDSNentry As String, strDrvEntry As String
Dim strValName As String, lngSzValName As Long
Dim strValData As String, lngSzValData As Long
Dim lngRetVal As Long, idx As Long
 
Select Case dsnType
   Case dsnuser
        lngRootKey = HKCU
   Case dsnSystem
        lngRootKey = HKLM
End Select
 
VerifierDSN = ""
 
strKey = "Software\ODBC\ODBC.INI\ODBC Data Sources" & vbNullChar
lngRetVal = RegOpenKeyEx(lngRootKey, strKey, _
             0, KEY_QUERY_VALUE, hKey)
 
idx = 0
Do While lngRetVal = 0
    lngSzValName = 256: strValName = String(257, vbNullChar)
    lngSzValData = 256: strValData = String(257, vbNullChar)
    lngRetVal = RegEnumValue(hKey, idx, strValName, lngSzValName, 0, _
          lngKeyType, strValData, lngSzValData)
    If Not lngRetVal Then
       strDSNentry = Left(strValName, lngSzValName)
       strDrvEntry = Left(strValData, lngSzValData)
       If LCase(strDSN) = LCase(strDSNentry) Then VerifierDSN = strDrvEntry: Exit Do
    End If
    idx = idx + 1
Loop
lngRetVal = RegCloseKey(hKey)
End Function

La fonction VerifierDSN prend en argument le nom de la source de données à rechercher et le type (utilisateur ou système).
En cas d'echec elle renvoie une chaîne de caractères vide.
En cas de succès le nom du pilote ODBC.

A+

[LedZeppII]

Finalement en cherchant un peu plus j'ai trouvé une autre méthode.

Code vb :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Option Compare Database
Option Explicit
 
' Début déclarations --------------------------------------
Private Declare Function SQLAllocEnv Lib "odbc32.dll" _
        (ByRef phenv As Long) As Byte
 
Private Declare Function SQLFreeEnv Lib "odbc32.dll" _
        (ByVal henv As Long) As Byte
 
Private Const SQL_FETCH_FIRST As Long = 2
Private Const SQL_FETCH_NEXT As Long = 1
 
Private Declare Function SQLDataSources Lib "odbc32.dll" ( _
        ByVal henv As Long, _
        ByVal fDirection As Integer, _
        ByVal szDSN As String, _
        ByVal cbDSNMax As Integer, _
        ByRef pcbDSN As Integer, _
        ByVal szDescription As String, _
        ByVal cbDescriptionMax As Integer, _
        ByRef pcbDescription As Integer) As Byte
' Fin déclarations
 
Public Function ExistDSN(strDataSource As String) As Boolean
Dim hSqlEnv As Long, sqlretVal As Byte, intDir As Integer
Dim strDSN As String, intDsnSize As Integer
Dim strDesc As String, intDescSize As Integer
Dim blnFuncRetVal As Boolean
 
blnFuncRetVal = False
sqlretVal = SQLAllocEnv(hSqlEnv)
intDir = SQL_FETCH_FIRST
Do While sqlretVal = 0
   strDSN = String(257, vbNullChar): intDsnSize = 256
   strDesc = String(257, vbNullChar): intDescSize = 256
   sqlretVal = SQLDataSources(hSqlEnv, intDir, _
               strDSN, 256, intDsnSize, _
               strDesc, 256, intDescSize)
   strDSN = Left(strDSN, intDsnSize)
   If LCase(strDSN) = LCase(strDataSource) Then blnFuncRetVal = True: Exit Do
   intDir = SQL_FETCH_NEXT
Loop
 
sqlretVal = SQLFreeEnv(hSqlEnv)
ExistDSN = blnFuncRetVal
End Function

La fonction ExistDSN prend en argument le nom de la source de donnée à vérifier et renvoie True ou False.
Elle parcours les sources de données Utilisateur et Système sans distinction.

A+

[Fredo67]

Hello,
merci pour ta rapidité, ça marche super bien ! génial !!!!
1000 Merci