Connect MS Access to SQL Server using ADO

Common procedures

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;" & _
                          "Data Source=" & ServerName & ";" & _
                          "Initial Catalog=" & DatabaseName & ";" & _
                          "USER ID=" & UserID & ";" & _
                          "PASSWORD=" & Password & ";"

    '# Windows Authentication Mode
    'cn.ConnectionString = "Provider=SQLOLEDB;" & _
    '                      "Data Source=" & ServerName & ";" & _
    '                      "Initial Catalog=" & 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 = adUseClient
    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 = adLockPessimistic
    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

Select

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 SampleTable"

    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

Update, Insert or Delete

Public Sub ExecuteSQL()

On Error GoTo ErrHandler

    Dim cn As New ADODB.Connection
    Dim sql As String

    Call OpenConnection(cn)

    sql = "INSERT INTO SampleTable (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