Summary

This article explains the way for connecting MS Access to SQL Server using ADO. It also covers the way to measure and compare performance differences between different settings of CursorLocation, CursorType and LockType.

Common procedures

The following reference need to be added to the references of VBAProject.
Microsoft ActiveX Data Objects x.x Library

'Set values of SQL Server
Private Const ServerName   As String = "myServerName"
Private Const DatabaseName As String = "myDatabaseName"
Private Const UserID       As String = "myID"
Private Const Password     As String = "myPassword"

Public Sub OpenConnection(ByRef cn As ADODB.Connection)    
    cn.ConnectionTimeout = 100 '100 seconds

    '# SQL Server Authentication Mode
    cn.ConnectionString = "Provider=SQLOLEDB;" & _
                          "Server=" & ServerName & ";" & _
                          "Database=" & DatabaseName & ";" & _
                          "USER ID=" & UserID & ";" & _
                          "PASSWORD=" & Password & ";"

    '# Windows Authentication Mode
    'cn.ConnectionString = "Provider=SQLOLEDB;" & _
    '                      "Server=" & ServerName & ";" & _
    '                      "Database=" & DatabaseName & ";" & _
    '                      "Integrated Security=SSPI;"

    cn.Open    
End Sub

Public Sub OpenRecordsetToRead(ByRef cn As ADODB.Connection, _
                               ByRef rs As ADODB.Recordset, _
                               ByVal sql As String)
    rs.CursorLocation = adUseServer
    rs.CursorType = adOpenForwardOnly
    rs.LockType = adLockReadOnly
    rs.ActiveConnection = cn
    rs.Source = sql
    rs.Open
End Sub

Public Sub OpenRecordsetToUpdate(ByRef cn As ADODB.Connection, _
                                 ByRef rs As ADODB.Recordset, _
                                 ByVal sql As String)
    rs.CursorLocation = adUseServer
    rs.CursorType = adOpenKeyset
    rs.LockType = adLockOptimistic
    rs.ActiveConnection = cn
    rs.Source = sql
    rs.Open
End Sub

Public Sub CloseRecordset(ByRef rs As ADODB.Recordset)
    If Not rs Is Nothing Then
        If rs.State = adStateOpen Then rs.Close
        Set rs = Nothing
    End If
End Sub

Public Sub CloseConnection(ByRef cn As ADODB.Connection)
    If Not cn Is Nothing Then
        If cn.State = adStateOpen Then cn.Close
        Set cn = Nothing
    End If
End Sub

See also Microsoft SQL documentation for ConnectionString of ADODB.Connection
Microsoft OLE DB Provider for SQL Server Overview

Use SQL SELECT statement

Note: The following code uses the common procedures listed at the top of the page.

Public Sub GetRecordset()

    On Error GoTo ErrHandler

    Dim sql As String

    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset

    sql = "SELECT * FROM TEST_TABLE"

    Call OpenConnection(cn)
    Call OpenRecordsetToRead(cn, rs, sql)

    If rs Is Nothing Or (rs.BOF And rs.EOF) Then
        Exit Sub
    End If

    Do Until rs.EOF
        Debug.Print rs.Fields(0).Value 'Show 1st filed of table
        Debug.Print rs.Fields(1).Value 'Show 2nd filed of table
        rs.MoveNext
    Loop

    Call CloseRecordset(rs)
    Call CloseConnection(cn)

    Exit Sub

ErrHandler:
    Call CloseRecordset(rs)
    Call CloseConnection(cn)
    Debug.Print "ErrNumber:" & Err.Number & " " & Err.Description

End Sub

Use SQL statement of INSERT, UPDATE and DELETE

Note: The following code uses the common procedures listed at the top of the page.

Public Sub ExecuteSQL()

    On Error GoTo ErrHandler

    Dim cn As New ADODB.Connection
    Dim sql As String

    Call OpenConnection(cn)

    sql = "INSERT INTO TEST_TABLE (No, FirstName, LastName) Values(1,'John','Smith')"

    'cn.BeginTrans '#Begin transaction    
    cn.Execute sql    
    'cn.CommitTrans '#Commit transaction

    Call CloseConnection(cn)

    Exit Sub

ErrHandler:
    'cn.RollbackTrans '#Rollback
    Call CloseConnection(cn)
    Debug.Print "ErrNumber:" & Err.Number & " " & Err.Description
End Sub

Properties of ADODB.Recordset

ADODB.Recordset has three properties to set.

CursorLocation
CursorType
LockType

See also Microsoft SQL documentation

If set properties are wrong, properties are modified to proper setting automatically.

The properties that you actually get in your application is dependent upon the data provider and the database that you are using.

The following table shows how the set properties are modified in my environment. Items written in red are the properties modified.

The table can be output from the following code.

Note1: The following code uses the common procedures listed at the top of the page.

Note2: The following code includes the process of reading all records in a table to measure execution time. It is better to use the table with fewer records to test the code.

Public Sub OutputAdoRecordsetProperty()

    On Error GoTo ErrHandler

    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim arrayCursorLocation() As Variant
    Dim arrayCursorType()     As Variant
    Dim arrayLockType()       As Variant
    Dim currentCursorLocation As Variant
    Dim currentCursorType     As Variant
    Dim currentLockType       As Variant
    Dim fieldsResult          As String
    Dim currentResult         As String
    Dim filePathResult        As String
    Dim startTime             As Double
    Dim endTime               As Double
    Dim executionTime         As Double
    Dim currentField          As Long
    Dim currentValue          As Variant

    arrayCursorLocation = Array(adUseClient, adUseServer)

    arrayCursorType = Array(adOpenDynamic, _
                            adOpenForwardOnly, _
                            adOpenKeyset, _
                            adOpenStatic)

    arrayLockType = Array(adLockBatchOptimistic, _
                          adLockOptimistic, _
                          adLockPessimistic, _
                          adLockReadOnly)

    filePathResult = CurrentProject.Path & "\AdoRsPropertyAbility.csv"

    fieldsResult = "Setting CursorLocation," & _
                   "Setting CursorType," & _
                   "Setting LockType," & _
                   "Actual CursorLocation," & _
                   "Actual CursorType," & _
                   "Actual LockType," & _
                   "adAddNew," & _
                   "adApproxPosition," & _
                   "adBookmark," & _
                   "adDelete," & _
                   "adFind," & _
                   "adHoldRecords," & _
                   "adIndex," & _
                   "adMovePrevious," & _
                   "adNotify," & _
                   "adResync," & _
                   "adSeek," & _
                   "adUpdate," & _
                   "adUpdateBatch," & _
                   "RecordCount, " & _
                   "Execution time"

    Call WriteCurrentResult(filePathResult, fieldsResult)

    Dim sql As String
    sql = "SELECT * FROM TEST_TABLE"

    For Each currentCursorLocation In arrayCursorLocation
        For Each currentCursorType In arrayCursorType
            For Each currentLockType In arrayLockType

                Call OpenConnection(cn)

                startTime = Timer

                rs.CursorLocation = currentCursorLocation
                rs.CursorType = currentCursorType
                rs.LockType = currentLockType
                rs.ActiveConnection = cn
                rs.Source = sql
                rs.Open

                'Setting Cursor Location
                currentResult = GetCursorLocation(currentCursorLocation) & ","

                'Setting CursorType
                currentResult = currentResult & GetCursorType(currentCursorType) & ","

                'Setting LockType
                currentResult = currentResult & GetLockType(currentLockType) & ","

                'Actual  CursorLocation
                currentResult = currentResult & GetCursorLocation(rs.CursorLocation) & ","

                'Actual  CursorType
                currentResult = currentResult & GetCursorType(rs.CursorType) & ","

                'Actual  LockType
                currentResult = currentResult & GetLockType(rs.LockType) & ","

                'CursorOptionEnum adAddNew
                currentResult = currentResult & rs.Supports(adAddNew) & ","

                'CursorOptionEnum adApproxPosition
                currentResult = currentResult & rs.Supports(adApproxPosition) & ","

                'CursorOptionEnum adBookmark
                currentResult = currentResult & rs.Supports(adBookmark) & ","

                'CursorOptionEnum adDelete
                currentResult = currentResult & rs.Supports(adDelete) & ","

                'CursorOptionEnum adFind
                currentResult = currentResult & rs.Supports(adFind) & ","

                'CursorOptionEnum adHoldRecords
                currentResult = currentResult & rs.Supports(adHoldRecords) & ","

                'CursorOptionEnum adIndex
                currentResult = currentResult & rs.Supports(adIndex) & ","

                'CursorOptionEnum adMovePrevious
                currentResult = currentResult & rs.Supports(adMovePrevious) & ","

                'CursorOptionEnum adNotify
                currentResult = currentResult & rs.Supports(adNotify) & ","

                'CursorOptionEnum adResync
                currentResult = currentResult & rs.Supports(adResync) & ","

                'CursorOptionEnum adSeek
                currentResult = currentResult & rs.Supports(adSeek) & ","

                'CursorOptionEnum adUpdate
                currentResult = currentResult & rs.Supports(adUpdate) & ","

                'CursorOptionEnum adUpdateBatch
                currentResult = currentResult & rs.Supports(adUpdateBatch) & ","

                'RecordCount
                currentResult = currentResult & rs.RecordCount & ","

                'Measure execution time
                Do Until rs.EOF
                    For currentField = 0 To rs.Fields.Count - 1
                        currentValue = rs.Fields(currentField).Value
                    Next
                    rs.MoveNext
                Loop
                endTime = Timer
                executionTime = endTime - startTime
                currentResult = currentResult & executionTime

                Call CloseRecordset(rs)

                Call WriteCurrentResult(filePathResult, currentResult)

                Call CloseConnection(cn)

            Next currentLockType
        Next currentCursorType
    Next currentCursorLocation

    MsgBox "Output has been completed.", vbInformation

    Exit Sub

ErrHandler:
    Call CloseRecordset(rs)
    Call CloseConnection(cn)
    MsgBox "ErrNumber:" & Err.Number & " " & Err.Description

End Sub

Private Function GetCursorLocation(ByVal lngCursorLocation As Long) As String
    Select Case lngCursorLocation
        Case 2
            GetCursorLocation = "adUseServer"
        Case 3
            GetCursorLocation = "adUseClient"
    End Select
End Function

Private Function GetCursorType(ByVal lngCursorType As Long) As String
    Select Case lngCursorType
        Case 0
            GetCursorType = "adOpenForwardOnly"
        Case 1
            GetCursorType = "adOpenKeyset"
        Case 2
            GetCursorType = "adOpenDynamic"
        Case 3
            GetCursorType = "adOpenStatic"
    End Select
End Function

Private Function GetLockType(ByVal lngLockType As Long) As String
    Select Case lngLockType
        Case 1
            GetLockType = "adLockReadOnly"
        Case 2
            GetLockType = "adLockPessimistic"
        Case 3
            GetLockType = "adLockOptimistic"
        Case 4
            GetLockType = "adLockBatchOptimistic"
    End Select
End Function

Private Sub WriteCurrentResult(ByVal filePathResult As String, _
                               ByVal currentResult As String)
    Open filePathResult For Append As #1
    Print #1, currentResult
    Close #1
End Sub

Blog

Connect MS Access to SQL Server using ADO

Wild Cat

Summary

Common procedures

Use SQL SELECT statement

Use SQL statement of INSERT, UPDATE and DELETE

Properties of ADODB.Recordset

Join Our Newsletter. No Spam, Only the good stuff.

Related