Option Explicit
Dim WithEvents gCN As ADODB.Connection
Private Sub Command1_Click()
OpenConnection
' Uncomment one function at a time
' ExecuteSQLWithConnection
' ExecuteSQLWithCommand1
' ExecuteSQLWithCommand2
' ExecuteParameterizedSQL
' ExecuteParameterizedSP
' ExecuteParameterizedSPWithRefers
' ExecuteBatchUpdate
' ExecuteMultipleSets
' ExecuteNewFeatures
CloseConnection
End Sub
' Shows how to open a connection and handle errors
Function OpenConnection()
' Set up error handling
On Error GoTo ConnectError
' Create the connection object
Set gCN = New ADODB.Connection
'Set some required properties
gCN.CommandTimeout = 100
gCN.ConnectionTimeout = 100
' USING OLE DB PROIVDER FOR ODBC
' Open using a DSN connection
'gCN.Open "PROVIDER=MSDASQL;DSN=pubs"
' Open using a DSN-less connection
'gCN.Open "PROVIDER=MSDASQL;DRIVER={SQL Server};SERVER=yazan;"
& _
"DATABASE=pubs;UID=sa;PWD="
' USING OLE DB PROVIDER FOR SQL SERVER
gCN.Open "PROVIDER=SQLOLEDB;DATA SOURCE=YAZAN;INITIAL
CATALOG=pubs;UID=sa;PWD="
' Handling errors
ConnectError:
Dim oErrors As ADODB.Errors
Dim oError As ADODB.Error
Dim strError As String
' First get the error collection from the connection object
Set oErrors = gCN.Errors
' Then enumerate all the error object in the error collection
For Each oError In oErrors
strError = "Description: " & oError.Description & vbCrLf & _
"Source: " & oError.Source & vbCrLf & _
"SQLState: " & oError.SQLState
MsgBox strError, vbCritical, "Connection Error"
Next
End Function
' Shows how to execute commands
Function ExecuteSQLWithConnection()
' execute a command using the connection object
' Note that the returned recordset is a read-only, forward-only and hence
' the count is set to -1.
Dim lRecordCount As Long
Dim rs1 As ADODB.Recordset
Set rs1 = gCN.Execute("authors", lRecordCount, adCmdTable)
' Clean up
Set rs1 = Nothing
End Function
' Show how to execute commands with the command object
Function ExecuteSQLWithCommand1()
' Declare the required variables
Dim oCommand As New ADODB.Command
Dim oRS As ADODB.Recordset
' Set command properties
oCommand.ActiveConnection = gCN
oCommand.CommandType = adCmdText
oCommand.CommandText = "select * from authors"
' Execute the command
Set oRS = oCommand.Execute
' Note that record count is -1 since the returned result set is a
' forward-only, read-only recordset
Dim lRecCount As Long
lRecCount = oRS.RecordCount
' Clean up
Set oCommand = Nothing
Set oRS = Nothing
End Function
' Show how to execute parameterized commands with the command object
Function ExecuteSQLWithCommand2()
' Set command properties
Dim oCmd As New ADODB.Command
oCmd.ActiveConnection = gCN
oCmd.CommandText = "select * from authors where au_lname = ?"
oCmd.CommandType = adCmdText
' ADO automatically created a parameter for the parameter holder.
' Now set the parameter value
With oCmd.Parameters.Item(0)
.Value = "White"
.Direction = adParamInput
.Type = adVarChar
.Size = 40
End With
' Execute the command
Dim oRS As ADODB.Recordset
Set oRS = oCmd.Execute
' Iterate over recordset
While Not (oRS.EOF)
Debug.Print oRS.Fields.Item(0) & " "; oRS.Fields.Item(1)
oRS.MoveNext
Wend
' Clean up
Set oRS = Nothing
Set oCmd = Nothing
End Function
' Shows how to use recordsets
Function ExecuteParameterizedSQL()
' Create a command object. Note the use of adCmdTableDirect to retrieve
' all fields in the specified table
Dim oCmd As New ADODB.Command
oCmd.ActiveConnection = gCN
oCmd.CommandText = "authors"
oCmd.CommandType = adCmdTable
' Now open a record set using the command object
' Note: Cannot use gCN to indicate the active connection since we're using
' the command object
' Note: not using New in declaring oRS results in an error. It means we
' declared oRS to be an object of type ADODB.Recordset but have not created
it.
Dim oRS As New ADODB.Recordset
oRS.Open oCmd, , adOpenKeyset, adLockOptimistic
' Now retrieve fields just for the first record
Dim oFields As Fields
Dim oField As Field
Set oFields = oRS.Fields
For Each oField In oFields
MsgBox "Field Name: " & oField.Name & vbCrLf & _
"Field value: " & oField.Value & vbCrLf & _
"Field type: " & oField.Type & vbCrLf, vbOKOnly
Next
' Retrieve some random properties of the recordset
Dim oProps As Properties
Dim oProp As Property
Set oProps = oRS.Properties
For Each oProp In oProps
Debug.Print oProp.Name & " " & oProp.Value & " " & oProp.Attributes
Next
' Clean up
Set oRS = Nothing
Set oCmd = Nothing
End Function
' Shows how to execute a stroed proc with parameters
Function ExecuteParameterizedSP()
' Create a command object to execute a stored proc
Dim oCmd As New ADODB.Command
oCmd.ActiveConnection = gCN
oCmd.CommandText = "CmdWithParamExample"
oCmd.CommandType = adCmdStoredProc
' Set up parameters for the stored proc: It takes an input, an output
' and returns a value. All three are integers. No need to create a parameter
' dim for each parameter. Use the same parameter object
Dim oPrm As ADODB.Parameter
' Return value
Set oPrm = oCmd.CreateParameter("Ret", adInteger, adParamReturnValue, 4)
oCmd.Parameters.Append oPrm
' Input
Set oPrm = oCmd.CreateParameter("In", adInteger, adParamInput, 4, 10)
oCmd.Parameters.Append oPrm
' Output
Set oPrm = oCmd.CreateParameter("Out", adInteger, adParamOutput, 4, -10)
oCmd.Parameters.Append oPrm
' Execute the command. Note that since we're using a client-side cursor,
' ADO will return a static cursor and not dynamic as we have requested!
Dim oRS As New ADODB.Recordset
oRS.CursorLocation = adUseClient
oRS.Open oCmd, , adOpenDynamic
' Since it's static, we can get the count
Dim lRecCount As Integer
lRecCount = oRS.RecordCount
' The output and return values are only available after the recordset
' has been closed
Debug.Print oCmd.Parameters.Item("In")
Debug.Print oCmd.Parameters.Item("Out")
Debug.Print oCmd.Parameters.Item("Ret")
' Clean up
Set oRS = Nothing
Set oCmd = Nothing
End Function
' Same as ExecuteParameterizedSP but obtains the parameters from the server
' using a referesh method
Function ExecuteParameterizedSPWithRefers()
' Create a command object to execute a stored proc
Dim oCmd As New ADODB.Command
oCmd.ActiveConnection = gCN
oCmd.CommandText = "CmdWithParamExample"
oCmd.CommandType = adCmdStoredProc
' AUTOMTICALLY Set up parameters for the stored proc and set their values
' Note that the return value is always at index zero
oCmd.Parameters.Refresh
oCmd.Parameters.Item(1).Value = 9 ' set up the input
' Execute the command. Note that since we're using a client-side cursor,
' ADO will return a static cursor and not dynamic as we have requested!
Dim oRS As New ADODB.Recordset
oRS.CursorLocation = adUseClient
oRS.Open oCmd, , adOpenDynamic
' Since it's static, we can get the count
Dim lRecCount As Integer
lRecCount = oRS.RecordCount
' The output and return values are only available after the recordset
' has been closed
Debug.Print oCmd.Parameters.Item(0) ' return value
Debug.Print oCmd.Parameters.Item(1) ' first sp param (input)
Debug.Print oCmd.Parameters.Item(2) ' second ap param (output)
' Clean up
Set oRS = Nothing
Set oCmd = Nothing
End Function
' Show how to use batch updating
Function ExecuteBatchUpdate()
On Error GoTo BatchUpdateError:
' all fields in the specified table
Dim oCmd As New ADODB.Command
oCmd.ActiveConnection = gCN
oCmd.CommandText = "authors"
oCmd.CommandType = adCmdTable
' Now open a record set using the command object
' Note: Cannot use gCN to indicate the active connection since we're using
' the command object. Note: not using New in declaring oRS results in an
' error. It means we declared oRS to be an object of type ADODB.Recordset but
' have not created it.
Dim oRS As New ADODB.Recordset
oRS.Open oCmd, , adOpenKeyset, adLockBatchOptimistic
gCN.BeginTrans
' Change the case of the 'state' field to lowercase for all records
While Not oRS.EOF
oRS.Fields.Item("State").Value = UCase(oRS.Fields.Item("State").Value)
oRS.MoveNext
Wend
' Now update all changes on the data base
oRS.UpdateBatch
gCN.CommitTrans
Exit Function
BatchUpdateError:
Dim oErrors As Errors
Dim oError As ErrObject
For Each oError In oErrors
Debug.Print oError.Description
Next
End Function
' Shows how to retrieve multiple sets
Function ExecuteMultipleSets()
On Error GoTo MultiSetErrors
' all fields in the specified table
Dim oCmd As New ADODB.Command
oCmd.ActiveConnection = gCN
oCmd.CommandText = "ReturnTwoSets"
oCmd.CommandType = adCmdStoredProc
' Retrieve the first result set
Dim oRS1 As New ADODB.Recordset
Dim oRS2 As New ADODB.Recordset
' Specifying use adUseClient will force the cursor type to be Static.
' This allows us to retrieve the recordset count immediately since the
' record set is now cahced on the client machine.
' adUseServer cannot be used when statements that generate more than one result set
oRS1.CursorLocation = adUseClient
oRS1.Open oCmd, , , adLockReadOnly
' Process the first result set
' ...
' Retrieve the next result set. Inherits
Set oRS2 = oRS1.NextRecordset
' Process the second result set
' ...
Exit Function
MultiSetErrors:
Dim oErrors As ADODB.Errors
Dim oError As ADODB.Error
Set oErrors = gCN.Errors
End Function
' Shows some new featrues of ADO
Function ExecuteNewFeatures()
' Get a result set
Dim oRS As New ADODB.Recordset
oRS.CursorLocation = adUseClient
oRS.Open "select top 10 au_fname, au_lname from authors",
gCN, adOpenStatic, adLockReadOnly, adCmdText
' Test GetString
Dim strRS As String
strRS = oRS.GetString(adClipString, 10)
MsgBox strRS, vbOKOnly, "GetString"
' Test ActiveCommand
MsgBox oRS.ActiveCommand.CommandText, vbOKOnly, "AcitveCommand"
'Use bookmarks
Dim vBookMark As Variant
oRS.MoveLast
vBookMark = oRS.Bookmark ' last
record is bookmarked
oRS.MoveFirst
' move away from the bookmarked record
oRS.Bookmark = vBookMark ' Now come back to the bookmarked record again.
' Use the append method to construct a record set
oRS.Close
oRS.Fields.Append "NewField1", adBSTR
End Function
' Shows how to close a connection
Function CloseConnection()
gCN.Close
End Function
' Helper
Private Sub gCN_ConnectComplete(ByVal pError As ADODB.Error,
adStatus As ADODB.EventStatusEnum,
ByVal pConnection As ADODB.Connection)
If adStatus = adStatusErrorsOccurred Then
MsgBox pError.Description, vbOKOnly, "Connection Complete Event"
Else
MsgBox "Connected!"
End If
End Sub
' Helper
Private Sub gCN_WillConnect(ConnectionString As String,
UserID As String,
Password As String,
Options As Long,
adStatus As ADODB.EventStatusEnum,
ByVal pConnection As ADODB.Connection)
MsgBox "Will connect using: " & ConnectionString, vbOKOnly, "Will Connect"
End Sub