Global Connection to a Microsoft Access Database Using ADO

Provided by the FMS Development Team

Does your application open and close many ADO recordsets? This can be a time consuming process, especially if you are running an application used by many users over a slow network connection. To remedy this issue, try creating a global connection to the database.

1. Create two global variables.

  Public gcnn As ADODB.Connection
  Public gcat As ADOX.Catalog

2. Create global function to make sure the global variables are assigned.

Public Function OpenAppConnection() As Boolean

  Dim fReturnValue As Boolean

  On Error GoTo Proc_Err

  If (gcnn Is Nothing) Or (gcat Is Nothing) Then
    Set gcat = Nothing
    Set gcnn = Nothing

    Set gcnn = Application.CurrentProject.Connection
    Set gcat = New ADOX.Catalog
    gcat.ActiveConnection = gcnn
  End If

  fReturnValue = True

Proc_Exit:
  OpenAppConnection = fReturnValue
  Exit Function

Proc_Err:
  fReturnValue = False
  Resume Proc_Exit

End Function

3. Assign the global variable to the .ActiveConnection property. To run the sample code, execute the subprocedure "Test".

' This example assumes the following:
'
' 1. The following references are set:
'    - Microsoft ActiveX Data Objects 2.1 Library
'    - Microsoft ADO Ext. 2.8 for DDL and Security
'
' 2. There exists a table called "Shippers".


Function OpenADORst( _
  ByRef rst As ADODB.Recordset, _
  ByVal strSQL As String) As Boolean

  Dim fReturnValue As Boolean

  On Error GoTo Proc_Err

  If OpenAppConnection Then
    With rst
      .CursorLocation = adUseServer
      .CursorType = adOpenDynamic
      .ActiveConnection = gcnn
      .LockType = adLockBatchOptimistic
      .Open strSQL
    End With

    fReturnValue = True
  Else
    fReturnValue = False
  End If

Proc_Exit:
  OpenADORst = fReturnValue
Exit Function

Proc_Err:
  fReturnValue = False
  Resume Proc_Exit

End Function

Public Sub Test()

  Dim rst As ADODB.Recordset
  Dim rst2 As ADODB.Recordset

  On Error Resume Next

  Set rst = New ADODB.Recordset
  Set rst2 = New ADODB.Recordset

  ' The connection will need to be established
  If OpenADORst(rst, "Select * From Shippers") Then
    MsgBox Prompt:="Opening of the recordset was successful!"
  Else
    MsgBox Prompt:="The recordset failed to open."
  End If

  ' The connection is already established
  If OpenADORst(rst2, "Select * From Shippers") Then
    MsgBox Prompt:="Opening of the recordset was successful!"
  Else
    MsgBox Prompt:="The recordset failed to open."
  End If

  Set rst = Nothing
  Set rst2 = Nothing

End Sub