Êàê îòêðûòü ïîäêëþ÷åíèå ADO è îáúåêòû íàáîðîâ çàïèñåé

   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