DEV Community

Wild Cat
Wild Cat

Posted on • Edited on

Connect MS Access to SQL Server using ADO

#vba

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
Enter fullscreen mode Exit fullscreen mode

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
Enter fullscreen mode Exit fullscreen mode

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
Enter fullscreen mode Exit fullscreen mode

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.

Image description

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
Enter fullscreen mode Exit fullscreen mode

Top comments (0)