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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
Option Explicit
Dim mRst As New ADODB.Recordset
Dim ADOCnx As New ADODB.Connection
Private Sub Form_Load()
'Déclaration de la variable de status connexion
Dim status_co As Boolean
Dim status_req As Boolean
'Declaration variable stockage requette
Dim rqe As String
status_co = InitConnection("xxxxx", "xxx", "xxx")
rqe = "SELECT clients.ncli, clients.nomcli FROM clients"
status_req = ExecSQL(rqe, mRst, ADOCnx)
mRst.MoveNext
List1.AddItem (mRst.Fields("ncli").Value)
End Sub
'===================================================================
' AUTHOR : DrQ
' FUNCTION : InitConnection(...)
' DESCRIPTION : Initiliase la connexion à la base de données
' PARAMS : * DSN : Nom du DSN associé à la connexion
' * UserName : Nom de l'utilisateur
' * Password : Mot de passe de l'utilisateur
' VERSION : 1.1
'===================================================================
Public Function InitConnection(DSN As String, UserName As String, PassWord As String) As Boolean
Dim query As String
Dim cnxString As String
Dim RequeteOk As Boolean
InitConnection = False
'Initialisation de la chaine de connexion
ADOCnx.ConnectionString = "DSN=" & DSN & ";"
'Vérifie que la connexion est bien fermée
If ADOCnx.State = adStateOpen Then
ADOCnx.Close
End If
On Error GoTo BadConnection
'Connexion à la base de données
ADOCnx.Open cnxString, UserName, PassWord, adAsyncConnect
'Attente que la connexion soit établie
While (ADOCnx.State = adStateConnecting)
DoEvents
Wend
'Vérification des erreurs dans le cas d'une mauvaise connexion
If ADOCnx.Errors.Count > 0 Then
'Affichage des erreurs
MsgBox ADOCnx.Errors.Item(0)
InitConnection = False
Exit Function
Else
InitConnection = True
End If
Exit Function
BadConnection:
If ADOCnx.Errors.Count > 0 Then
'Affichage des erreurs
MsgBox ADOCnx.Errors.Item(0)
InitConnection = False
Exit Function
Else
MsgBox Err.Description
End If
End Function
'============================================================================='
' FUNCTION : ExecSQL(...)
' DESCRIPTION : Execute une requête SQL
' PARAMS : * query : Requête à exécuter
' * rst : Variable permettant de stocker les enregistrements
'============================================================================='
Public Function ExecSQL(query As String, ByRef rst As ADODB.Recordset, ByRef cnx As ADODB.Connection) As Boolean
'Initialisation du RecordSet
If rst.State <> adStateClosed Then rst.Close
'Ouvre une transaction pour ne pas à avoir à réaliser de commit en fin de traitement
ADOCnx.BeginTrans
'Positionne le curseur côté client
rst.CursorLocation = adUseClient
'Vérifie que la connexion passée est bonne
'Set rst.ActiveConnection = cnx On Error GoTo ErrHandle
'Exécute la requête
rst.Open query, ADOCnx
'Valide la transaction
ADOCnx.CommitTrans
ExecSQL = True
Exit Function
ErrHandle:
ExecSQL = False
MsgBox "ADOManager.ExecSQL:ErrHandle" & vbCr & vbCr & Err.Description, vbCritical
End Function |
