Sources

 

Trois types de connection (Access, Dsn ODBC, ODBC) et trois types de recordset

Option Explicit
Private Sub cmdOpen_Click()
Dim Conn1 As New adodb.Connection
Dim Cmd1 As New adodb.Command
Dim Errs1 As Errors
Dim Rs1 As New adodb.Recordset
Dim i As Integer
Dim AccessConnect As String
' Variables de traitement de erreurs
Dim errLoop As Error
Dim strTmp As String

AccessConnect = "Driver={Microsoft Access Driver (*.mdb)};" & _
"Dbq=nwind.mdb;" & _
"DefaultDir=C:\program files\devstudio\vb;" & _
"Uid=Admin;Pwd=;"

'--------------------------- ' Mèthodes de connection aux objets'---------------------------
On Error GoTo AdoError
' Full Error Handling which traverses
' objet Connection

' Open Connection mèthode #1: Ouvrir par la propriété ConnectionString
Conn1.ConnectionString = AccessConnect
Conn1.Open
Conn1.Close
Conn1.ConnectionString = ""

' Open Connection mèthode #2: Open("[ODBC Connect String]","","")
Conn1.Open AccessConnect
Conn1.Close

' Open Connection mèthode #3: Open("DSN","Uid","Pwd")
Conn1.Open "Driver={Microsoft Access Driver (*.mdb)};" & _
"DBQ=nwind.mdb;" & _
"DefaultDir=C:\program files\devstudio\vb;" & _
"Uid=Admin;Pwd=;"
Conn1.Close
'-------------------------- ' Recordset Object Methods '--------------------------
' Don't assume that we have a connection object.
On Error GoTo AdoErrorLite

' Recordset Open Method #1: Open via Connection.Execute(...)
Conn1.Open AccessConnect
Set Rs1 = Conn1.Execute("SELECT * FROM Employees")
Rs1.Close
Conn1.Close

' Recordset Open Method #2: Open via Command.Execute(...)
Conn1.ConnectionString = AccessConnect
Conn1.Open
Cmd1.ActiveConnection = Conn1
Cmd1.CommandText = "SELECT * FROM Employees"
Set Rs1 = Cmd1.Execute
Rs1.Close
Conn1.Close
Conn1.ConnectionString = ""

' Recordset Open Method #3: Open w/o Connection & w/Connect String

Rs1.Open "SELECT * FROM Employees", AccessConnect, adOpenForwardOnly

Rs1.Close
Done:
Set Rs1 = Nothing
Set Cmd1 = Nothing
Set Conn1 = Nothing
Exit Sub

AdoError:
i = 1
On Error Resume Next
' Enumerate Errors collection and display properties of
' each Error object (if Errors Collection is filled out)
Set Errs1 = Conn1.Errors
For Each errLoop In Errs1
With errLoop
strTmp = strTmp & vbCrLf & "ADO Error # " & i & ":"
strTmp = strTmp & vbCrLf & " ADO Error # " & .Number
strTmp = strTmp & vbCrLf & " Description " & .Description
strTmp = strTmp & vbCrLf & " Source " & .Source i = i + 1
End With

Next

AdoErrorLite:
' Get VB Error Object's information
strTmp = strTmp & vbCrLf & "VB Error # " & Str(Err.Number)
strTmp = strTmp & vbCrLf & " Generated by " & Err.Source
strTmp = strTmp & vbCrLf & " Description " & Err.Description
MsgBox strTmp
' Clean up gracefully without risking infinite loop in error handler
On Error GoTo 0
GoTo Done

End Sub