Connessione e Recordset

Nelle referenze del progetto inserire ADODB.DLL


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

' Error Handling Variables

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=;"

'---------------------------

' Connection Object Methods

'---------------------------


On Error GoTo AdoError ' Full Error Handling which traverses
' Connection object


' Connection Open method #1: Open via ConnectionString Property

Conn1.ConnectionString = AccessConnect
Conn1.Open
Conn1.Close
Conn1.ConnectionString = ""

' Connection Open method #2: Open("[ODBC Connect String]","","")

Conn1.Open AccessConnect
Conn1.Close

' Connection Open method #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 via Command.Execute(...)

Conn1.ConnectionString = AccessConnect
Conn1.Open
Cmd1.ActiveConnection = Conn1
Cmd1.CommandText = "SELECT * FROM Employees"
Rs1.Open Cmd1
Rs1.Close
Conn1.Close
Conn1.ConnectionString = ""

' Recordset Open Method #4: 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