Sheet 1

Option Explicit
Private WithEvents AsyncConnection As ADODB.Connection
Public Sub AsyncConnectionToDatabase()
Const ConnectionString As String = _
"Provider=Microsoft.Jet.OLEDB.4.0;" + _
"Data Source=C:\Program Files\Microsoft " + _
"Office\OFFICE11\SAMPLES\Northwind.mdb;Persist Security Info=False"
Set AsyncConnection = New ADODB.Connection
AsyncConnection.Mode = adModeRead
AsyncConnection.ConnectionString = ConnectionString
AsyncConnection.Open
Const SQL As String = _
"SELECT * FROM Customers WHERE Country = 'USA'"
Call AsyncConnection.Execute(SQL, , CommandTypeEnum.adCmdText _
Or ExecuteOptionEnum.adAsyncExecute)
Debug.Print "I ran before the query finished"
End Sub
Private Sub AsyncConnection_ExecuteComplete(ByVal RecordsAffected As Long, _
ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, _
ByVal pCommand As ADODB.Command, _
ByVal pRecordset As ADODB.Recordset, _
ByVal pConnection As ADODB.Connection)
Debug.Print "Query finished"
' Checks to determine if we have any data
If (pRecordset.EOF And pRecordset.BOF) Then
Debug.Print "There is no data"
End If
' Checks for errors
Dim E As Error
For Each E In pConnection.Errors
Debug.Print E.Value
Next
' Demonstrates an additional filter on the recordset
pRecordset.Filter = "Region = 'OR'"
' Dumps the records based on the filter
While (Not pRecordset.EOF)
Debug.Print pRecordset("Region").Value
pRecordset.MoveNext

Wend
' Ignores the filter
If (adStatus = EventStatusEnum.adStatusOK) Then
Call Sheet1.Range("A1").CopyFromRecordset(pRecordset)
End If
If (pConnection.State = ObjectStateEnum.adStateOpen) Then
pConnection.Close
End If
End Sub
Public Sub RecordsetNavigation()
Const SQL As String = _
"SELECT * FROM Customers"
Const ConnectionString As String = _
"Provider=Microsoft.Jet.OLEDB.4.0;" + _
"Data Source=C:\Program Files\Microsoft " + _
"Office\OFFICE11\SAMPLES\Northwind.mdb;Persist Security Info=False"
Dim Recordset As Recordset
Set Recordset = New Recordset
Call Recordset.Open(SQL, ConnectionString, adOpenDynamic)
Recordset.MoveLast
While Not Recordset.BOF
Debug.Print Recordset.Fields("CompanyName")
Recordset.MovePrevious
Wend
End Sub
Public Sub DescribeARow()
Const SQL As String = _
"SELECT * FROM Customers"
Const ConnectionString As String = _
"Provider=Microsoft.Jet.OLEDB.4.0;" + _
"Data Source=C:\Program Files\Microsoft " + _
"Office\OFFICE11\SAMPLES\Northwind.mdb;Persist Security Info=False"
Dim Recordset As Recordset
Set Recordset = New Recordset
Call Recordset.Open(SQL, ConnectionString, adOpenDynamic)
Recordset.MoveFirst
Dim Field As Field

For Each Field In Recordset.Fields

Debug.Print "Name: " & Field.Name
Debug.Print "Type: " & Field.Type
Debug.Print "Size: " & Field.ActualSize
Debug.Print "Value: " & Field.Value
Debug.Print "***********************"
Next
End Sub
Public Sub CallStoredProcedure()
Const ConnectionString As String = _
"Provider=SQLOLEDB.1;Integrated Security=SSPI;" + _
"Persist Security Info=False;Initial Catalog=NorthwindCS;" + _
"Data Source=LAP800;Workstation ID=LAP800;"
Dim Command As Command
Set Command = New Command
Command.ActiveConnection = ConnectionString
Command.CommandText = "[Sales by Year]"
Command.CommandType = CommandTypeEnum.adCmdStoredProc
Dim BeginningDate As ADODB.Parameter
Dim EndingDate As ADODB.Parameter
Dim StartDate As Date
StartDate = #1/1/1995#
Dim EndDate As Date
EndDate = #1/1/2004#
Set BeginningDate = Command.CreateParameter("@Beginning_Date", _
DataTypeEnum.adDate, ParameterDirectionEnum.adParamInput, , StartDate)
Set EndingDate = Command.CreateParameter("@Ending_Date", _
DataTypeEnum.adDate, ParameterDirectionEnum.adParamInput, , EndDate)
Call Command.Parameters.Append(BeginningDate)
Call Command.Parameters.Append(EndingDate)
Dim Recordset As ADODB.Recordset
Set Recordset = Command.Execute
Call Sheet1.Range("A1").CopyFromRecordset(Recordset)
End Sub
Public Sub PlainTextQuery()
Const ConnectionString As String = _
"Provider=Microsoft.Jet.OLEDB.4.0;" + _

"Data Source=C:\Program Files\Microsoft " + _

"Office\OFFICE11\SAMPLES\Northwind.mdb;Persist Security Info=False"
Dim Recordset As ADODB.Recordset
' Define the SQL Statement
Const SQL As String = _
"SELECT CompanyName, ContactName " & _
"FROM Customers " & _
"WHERE Country = 'UK' " & _
"ORDER BY CompanyName"
' Initialize the Recordset object and run the query
Set Recordset = New ADODB.Recordset
Call Recordset.Open(SQL, ConnectionString, CursorTypeEnum.adOpenForwardOnly, _
LockTypeEnum.adLockReadOnly, CommandTypeEnum.adCmdText)
' Make sure we got records back
If Not Recordset.EOF Then
' Dump the contents of the recordset onto the worksheet
Call Sheet1.Range("A2").CopyFromRecordset(Recordset)
' Add headers to the worksheet
With Sheet1.Range("A1:B1")
.Value = Array("Company Name", "Contact Name")
.Font.Bold = True
End With
' Fit the column widths to the data
Sheet1.UsedRange.EntireColumn.AutoFit
Else
Call MsgBox("Error: No records returned.", vbCritical)
End If
' Close the recordset if it is still open
If (Recordset.State And ObjectStateEnum.adStateOpen) Then Recordset.Close
Set Recordset = Nothing
End Sub
Public Sub SavedQuery()
Dim Field As ADODB.Field
Dim Recordset As ADODB.Recordset
Dim Offset As Long
Const ConnectionString As String = _
"Provider=Microsoft.Jet.OLEDB.4.0;" + _
"Data Source=C:\Program Files\Microsoft " + _
"Office\OFFICE11\SAMPLES\Northwind.mdb;Persist Security Info=False"
' Create the Recorset object and run the query.
Set Recordset = New ADODB.Recordset
Call Recordset.Open("[Sales By Category]", ConnectionString, _

CursorTypeEnum.adOpenForwardOnly, LockTypeEnum.adLockReadOnly, _
CommandTypeEnum.adCmdTable)
' Make sure we got records back
If Not Recordset.EOF Then
' Add headers to the worksheet.
With Sheet1.Range("A1")
For Each Field In Recordset.Fields
.Offset(0, Offset).Value = Field.Name
Offset = Offset + 1
Next Field
.Resize(1, Recordset.Fields.Count).Font.Bold = True
End With
' Dump the contents of the recordset onto the worksheet.
Call Sheet1.Range("A2").CopyFromRecordset(Recordset)
' Fit the column widths to the data.
Sheet1.UsedRange.EntireColumn.AutoFit
Else
MsgBox "Error: No records returned.", vbCritical
End If
' Close the recordset
Recordset.Close
Set Recordset = Nothing
End Sub

Public Sub CheckError(ByVal RecordsAffected As Long, _

ByVal Expected As Long, ByVal Description As String)
If RecordsAffected <> Expected Then
Call RaiseError(Description)
End If
End Sub
Public Sub RaiseError(ByVal Description As String)
Call Err.Raise(vbObjectError + 1024, , Description)
End Sub
Public Function GetPrimaryKey(ByVal Command As ADODB.Command) As Long
Dim RecordsAffected As Long
Dim Recordset As ADODB.Recordset
' Retrieve the primary key generated for our new record.
Command.CommandText = "SELECT @@IDENTITY"
Set Recordset = Command.Execute(Options:=CommandTypeEnum.adCmdText)

If Recordset.EOF Then
Call RaiseError("Error retrieving primary key value.")
End If
GetPrimaryKey = Recordset.Fields(0).Value
Recordset.Close
End Function
Public Sub ExecuteCommand(ByVal Command As ADODB.Command, _
ByVal CommandText As String, _
ByVal Description As String)
Dim RecordsAffected As Long
Command.CommandText = CommandText
Call Command.Execute(RecordsAffected, , _
CommandTypeEnum.adCmdText Or ExecuteOptionEnum.adExecuteNoRecords)
Call CheckError(RecordsAffected, 1, Description)
End Sub
Public Sub InsertRecord(ByVal Command As ADODB.Command)
Const CommandText As String = _
"INSERT INTO Shippers(CompanyName, Phone) " & _
"VALUES('Air Carriers', '(205) 555 1212')"
Const Description As String = _
"Error executing INSERT statement."
Call ExecuteCommand(Command, CommandText, Description)
End Sub
Public Sub UpdateRecord(ByVal Command As ADODB.Command, ByVal Key As Long)
Dim CommandText As String
CommandText = _
"UPDATE Shippers SET Phone='(206) 546 0086' " & _
"WHERE ShipperID=" & CStr(Key) & ";"
Const Description As String = _
"Error executing UPDATE statement."
Call ExecuteCommand(Command, CommandText, Description)
End Sub
Public Sub DeleteRecord(ByVal Command As ADODB.Command, ByVal Key As Long)
Dim CommandText As String

CommandText = "DELETE FROM Shippers WHERE ShipperID = " & CStr(Key) & ";"
Const Description As String = _
"Error executing DELETE statement."
Call ExecuteCommand(Command, CommandText, Description)
End Sub
Private Property Get ConnectionString() As String
ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" + _
"Data Source=C:\Program Files\Microsoft " + _
"Office\OFFICE11\SAMPLES\Northwind.mdb;Persist Security Info=False"
End Property
Public Sub InsertUpdateDelete()
Dim Command As ADODB.Command
Dim Key As Long
On Error GoTo ErrorHandler
Set Command = New ADODB.Command
Command.ActiveConnection = ConnectionString
Call InsertRecord(Command)
Key = GetPrimaryKey(Command)
Call UpdateRecord(Command, Key)
Call DeleteRecord(Command, Key)
ErrorExit:
Set Command = Nothing
Exit Sub
ErrorHandler:
Call MsgBox(Err.Description, vbCritical)
Resume ErrorExit
End Sub

Sheet 2
Public Sub ExecuteStoredProcAsMethod()
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Const ConnectionString As String = _
"Provider=SQLOLEDB.1;Integrated Security=SSPI;" + _
"Persist Security Info=False;Initial Catalog=NorthwindCS;" + _
"Data Source=LAP800;Workstation ID=LAP800;"
On Error GoTo Cleanup
Set Connection = New ADODB.Connection
Set Recordset = New ADODB.Recordset
Call Connection.Open(ConnectionString)
Dim StartDate As Date, EndDate As Date
StartDate = #1/1/1995#
EndDate = #1/1/2004#
Connection.Employee_Sales_by_Country StartDate, EndDate, Recordset
Call Sheet1.Range("A1").CopyFromRecordset(Recordset)
Sheet1.UsedRange.EntireColumn.AutoFit
Cleanup:
If (Err.Number <> 0) Then Debug.Print Err.Description
If (Connection.State = ObjectStateEnum.adStateOpen) Then Connection.Close
If (Recordset.State = ObjectStateEnum.adStateOpen) Then Recordset.Close
End Sub

Sheet 3
Option Explicit
Private Const ConnectionString As String = _
"Provider=SQLOLEDB.1;Integrated Security=SSPI;" + _
"Persist Security Info=False;Initial Catalog=NorthwindCS;" + _
"Data Source=LAP800;Workstation ID=LAP800;"
Public Command As ADODB.Command
Public Connection As ADODB.Connection
Private Sub CreateConnection()
Set Connection = New ADODB.Connection
Call Connection.Open(ConnectionString)
End Sub
Private Sub DestroyConnection()
If (Connection.State = ObjectStateEnum.adStateOpen) Then
Connection.Close
End If
Set Connection = Nothing
End Sub
Private Sub PrepareCommandObject()
Set Command = New ADODB.Command
Set Command.ActiveConnection = Connection
Command.CommandText = "InsertShippers"
Command.CommandType = adCmdStoredProc
Call Command.Parameters.Append( _
Command.CreateParameter("@RETURN_VALUE", DataTypeEnum.adInteger, _
ParameterDirectionEnum.adParamReturnValue, 0))
Call Command.Parameters.Append( _
Command.CreateParameter("@CompanyName", DataTypeEnum.adVarWChar, _
ParameterDirectionEnum.adParamInput, 40))
Call Command.Parameters.Append( _
Command.CreateParameter("@Phone", DataTypeEnum.adVarWChar, _
ParameterDirectionEnum.adParamInput, 24))
End Sub
Public Sub UseCommandObject()
Dim Key As Long
Dim RecordsAffected As Long
On Error GoTo ErrorHandler
CreateConnection
PrepareCommandObject
Command.Parameters("@CompanyName").Value = "Air Carriers"

Command.Parameters("@Phone").Value = "(206) 555 1212"

Call Command.Execute(RecordsAffected, , ExecuteOptionEnum.adExecuteNoRecords)
If (RecordsAffected <> 1) Then
Call Err.Raise(vbObjectError + 1024, , _
Description:="Error executing Command object.")
End If
Key = Command.Parameters("@RETURN_VALUE").Value
Debug.Print "The key value of the new record is: " & CStr(Key)
ErrorExit:
Set Command = Nothing
DestroyConnection
Exit Sub
ErrorHandler:
Call MsgBox(Err.Description, vbCritical)
Resume ErrorExit
End Sub

Sheet 4
Option Explicit
Private Const ConnectionString As String = _
"Provider=SQLOLEDB.1;Integrated Security=SSPI;" + _
"Persist Security Info=False;Initial Catalog=NorthwindCS;" + _
"Data Source=LAP800;Workstation ID=LAP800;"
Public Connection As ADODB.Connection
Public Recordset As ADODB.Recordset
Public Sub CreateDisconnectedRecordset()
Dim SQL As String
SQL = "SELECT CustomerID, CompanyName, ContactName, Country " & _
"FROM Customers"
Set Connection = New ADODB.Connection
Connection.ConnectionString = ConnectionString
Connection.Open
Set Recordset = New ADODB.Recordset
Recordset.CursorLocation = CursorLocationEnum.adUseClient
Recordset.CursorType = CursorTypeEnum.adOpenStatic
Recordset.LockType = LockTypeEnum.adLockBatchOptimistic
Call Recordset.Open(SQL, Connection, , , CommandTypeEnum.adCmdText)
Set Recordset.ActiveConnection = Nothing
Call Sheet4.Range("A1").CopyFromRecordset(Recordset)
' Connection intentionally left open
End Sub
Public Sub FilterDisconnectedRecordset()
Call Sheet4.Range("A:D").Clear
Recordset.Filter = "Country = 'Germany'"
Recordset.Sort = "CompanyName"
Call Sheet4.Range("A1").CopyFromRecordset(Recordset)
End Sub
Public Sub RequeryConnection()
Set Recordset.ActiveConnection = Connection
Call Recordset.Requery(Options:=CommandTypeEnum.adCmdText)
Set Recordset.ActiveConnection = Nothing
End Sub

Form 1
Option Explicit
Private Const ConnectionString As String = _
"Provider=SQLOLEDB.1;Integrated Security=SSPI;" + _
"Persist Security Info=False;Initial Catalog=NorthwindCS;" + _
"Data Source=LAP800;Workstation ID=LAP800;"
Private Sub UserForm_Initialize()
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Set Connection = New ADODB.Connection
Connection.ConnectionString = ConnectionString
Connection.Open
Set Recordset = New ADODB.Recordset
Call Recordset.Open("GetLookupValues", Connection, _
CursorTypeEnum.adOpenForwardOnly, LockTypeEnum.adLockReadOnly, _
CommandTypeEnum.adCmdStoredProc)
Do While Not Recordset.EOF
Call ComboBoxCustomers.AddItem(Recordset.Fields(1).Value)
Recordset.MoveNext
Loop
Set Recordset = Recordset.NextRecordset
Do While Not Recordset.EOF
Call ComboBoxShippers.AddItem(Recordset.Fields(1).Value)
Recordset.MoveNext
Loop
' Closes the recordset implicitly
Set Recordset = Recordset.NextRecordset
If (Connection.State = ObjectStateEnum.adStateOpen) Then Connection.Close
End Sub

 Module 1
Option Explicit
Public Sub ConnectToDatabase()
Const ConnectionString As String = _
"Provider=Microsoft.Jet.OLEDB.4.0;" + _
"Data Source=C:\Program Files\Microsoft " + _
"Office\OFFICE11\SAMPLES\Northwind.mdb;Persist Security Info=False"
Dim Connection As ADODB.Connection
Set Connection = New ADODB.Connection
Connection.ConnectionString = ConnectionString
Connection.Open
Debug.Print Connection.State = ObjectStateEnum.adStateOpen
Const SQL As String = _
"SELECT * FROM Customers WHERE Country = 'USA'"
Dim Recordset As Recordset
Dim RowsAffected As Long
Set Recordset = Connection.Execute(SQL, RowsAffected, CommandTypeEnum.adCmdText)
Debug.Print "Rows affected " & RowsAffected
Call Sheet1.Range("A1").CopyFromRecordset(Recordset)
If (Connection.State = ObjectStateEnum.adStateOpen) Then
Connection.Close
End If
End Sub