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
Top comments (0)