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 |
Partager