Microsoft Access, Office/VBA, VB6 Modules royalty-free source code library

Microsoft Access Modules royalty-free source code library

Microsoft Access VBA and VB6 Module Library

Free trial of Total Visual SourceBook for Microsoft Access, Office, VB6 and VBA

Class: RDOConnection in Category SQL Server : SQL Server from Total Visual SourceBook

Class to support client/server operations using the Remote Data Access to set up an ODBC connection to a data source using VB6 and VBA.

When using Visual Basic to deploy client/server applications, you have a variety of development choices. You can use DAO and Jet, DAO and ODBC Direct, RDO and the Remote Data Control, or program directly against the API. This class exposes functionality to use RDO against ODBC data sources. For information on the other choices, see the other classes in the Database category. This class was designed and tested against an ODBC connection using Microsoft SQL Server. The behavior with other servers may be slightly different. Note that this code is not supported in the 64-bit version of Access 2010 or 2013 due to the use of the 32 bit library MSRDO20.DLL. RDO was designed specifically to access remote ODBC relational data sources, and made it easier to use ODBC without complex application code. It was included with Microsoft Visual Basic versions 4, 5, and 6. RDO version 2.0 is the final version of this technology.

Procedure List

Procedure Name	Type	Description
(Declarations)	Declarations	Declarations and private variables for the CRDOConnection class.
ConnectDatabaseName	Property	Get the database name in use by the current remote connection. This property represents the name of the remote database. When the class is initialized, this property has no value. Before calling the OpenConnection method, set this property to the name of the remote database you want to connect to. If you don't specify a value for this property, the DatabaseName specified by the current DSN (specified by the ConnectDSN property) will be used. If the current DSN does not have a valid DatabaseName value, calls to the OpenConnection will cause the ODBC driver to display a dialog, prompting for the information, unless the Prompt property has been set to rdDriverNoPrompt. For more information on how the Connect properties work, see the documentation for this class.
ConnectDriver	Property	Get the Driver name in use by the current remote connection (used when created DSN-less connections). When the class is initialized, this property has no value. If you are specifying a DSN to use to open the connection, this property is not required. Instead the driver is determined by the DSN you are using. If you want to create a "DSN-less" connection, you must specify this property, as well as the "ConnectServer" property, and then omit the "ConnectDSN" property. The ConnectDriver string must be formatted correctly in order to make the connection. Two common examples for this property are: {SQL Server} {Microsoft Access Driver (*.mdb)} Notice that you MUST include the {} characters around the value. To find out a valid value for this property for the driver you are using, you can create a "file DSN" and examine it with a text editor such as Notepad. For more information on how the Connect properties work, see the documentation for this class.
ConnectDSN	Property	Get the DSN name used in the current connection. When the class is initialized, this property has no value. Before calling the OpenConnection method, set this property to the name of the DSN you want to use. For more information on how the Connect properties work, see the documentation for this class.
Connection	Property	Get a pointer to the local rdoConnection object that was either created by the class (with OpenConnection method), or was previously assigned to this property by the user (with the 'set' statement). Using this property you can have access to the rdoConnection methods and properties that are not directly exposed by this class. For instance you can use CreateQuery to create and rdoQuery object, or Execute to execute an action query against a remote data source. For example, this is how you might use the Connection property of this class to open an rdoResultset object: Dim rdc As New CRDOConnection Dim rst As RDO.rdoResultset rdc.ConnectDSN = "pubs" rdc.ConnectUserID = "sa" rdc.Prompt = rdDriverNoPrompt rdc.OpenConnection Set rst = rdc.Connection.OpenResultSet("select stor_name from stores "where stor_id = '7066'") If Not rst.EOF Then Debug.Print rst!stor_name End If rst.Close rdc.CloseConnection If you already have an rdoConnection object available and you want to assign it to the Connection property of this class, so you can manage it there, you can assign it with code like so: Dim cnnLocal As RDO.rdoConnection Dim rdc As CRDOConnection Set cnnLocal = New RDO.rdoConnection Set rdc = New CRDOConnection ' Create standard rdoConnection object cnnLocal.Connect = "dsn=pubs;uid=sa;pwd=" cnnLocal.EstablishConnection rdDriverNoPrompt, False ' Assign it to the Connection property of the CRDOConnection object Set rdc.Connection = cnnLocal ' Show that rdc is using the connection provided to it Debug.Print rdc.ConnectString
ConnectPassword	Property	Get the password used by the current connection. This property represents the password used to connect to the remote database. When the class is initialized, this property has no value. Before calling the OpenConnection method, set this property to the password for the user account you wish to use. If you don't specify a value for this property, the password specified by the current DSN (specified by the ConnectDSN property) will be used. If the current DSN does not have a valid password value, calls to the OpenConnection will cause the ODBC driver to display a dialog, prompting for the information, unless the Prompt property has been set to rdDriverNoPrompt. For more information on how the Connect properties work, see the documentation for this class.
ConnectServer	Property	Get the name of the server used by the current remote connection. This property represents the name of the ODBC server machine used to connect to the remote database. When the class is initialized, this property has no value. If you are specifying a DSN to use to open the connection, this property is not required. Instead the server is determined by the DSN you are using. If you want to create a "DSN-less" connection, you must specify this property, as well as the "ConnectDriver" property, and then omit the "ConnectDSN" property. For more information on how the Connect properties work, see the documentation for this class. ' Returns : Server name
ConnectString	Property	Get the current Connect string in use by the connection. Its value is built from the ConnectPassword, ConnectUserID, ConnectDatabaseName, ConnectDatabase, ConnectDriver, and ConnectDSN properties. This property represents the connect string parameter that is passed to the RDO EstablishConnection method in the class OpenConnection method. The connect string identifies the parameters that ODBC needs to open a remote data source. When the class is initialized, this property contains a blank string. When you call the OpenConnection method, the class takes each of the individual Connect... properties and merges them into a connect string that is then passed to the RDO EstablishConnection method. When you manually assign an rdoConnection object to the Connection property of the class, the class sets this property to the value of the rdoConnection's connect property. For more information on how the Connect properties work, see the documentation for this class.
ConnectUserID	Property	Get the user name used by the current connection. When the class is initialized, this property has no value. Before calling the OpenConnection method, set this property to the user name you wish to use. If you don't specify a value for this property, the user id specified by the current DSN (specified by the ConnectDNS property) will be used. If the current DSN does not have a valid user id value, calls to the OpenConnection method will cause the ODBC driver to display a dialog, prompting for the information, unless the Prompt property has been set to rdDriverNoPrompt. For more information on how the Connect properties work, see the documentation for this class.
CursorDriver	Property	Get the cursor driver used to open the current connection. The value is a long integer set to one of the following enumerated constant values: rdUseIfNeeded 0: The ODBC driver will choose the appropriate style of cursors. Server-side cursors are used if they are available. rdUseOdbc 1: RemoteData will use the ODBC cursor library. rdUseServer 2: Use server-side cursors. rdUseClientBatch 3: RDO will use the optimistic batch cursor library. rdUseNone 4: Result set is not returned as a cursor. The default value for this class is rdUseIfNeeded. See the VBA/VB6 RDO documentation for more information.
Options	Property	Get the connection options used to create the connection. The value is a long integer set to one of the following enumerated constant values: rdAsyncEnable 32: Execute operation asynchronously. rdExecDirect 64: Execute query using SQLExecDirect instead of SQLPrepare/ SQLExecute. The rdoQuery object's Prepared property also controls this feature. rdFetchLongColumns 128: Download all the data for long character and long binary columns. rdUseClientBatch 3: RDO will use the optimistic batch cursor library. rdUseNone 4: Result set is not returned as a cursor. The default value for this class is 0. See the VBA/VB6 RDO documentation for more information on Options settings.
Prompt	Property	Get the connection options used to create the connection. The value is a long integer set to one of the following enumerated constant values: rdAsyncEnable 32: Execute operation asynchronously. rdExecDirect 64: Execute query using SQLExecDirect instead of SQLPrepare/ SQLExecute. The rdoQuery object's Prepared property also controls this feature. rdFetchLongColumns 128: Download all the data for long character and long binary columns. rdUseClientBatch 3: RDO will use the optimistic batch cursor library. rdUseNone 4: Result set is not returned as a cursor. The default value for this class is 0. See the VBA/VB6 RDO documentation for more information on Options settings. Get how ODBC prompts for connection parameters if insufficient data is provided to make the connection. The value is a long integer set to one of the following enumerated constant values: rdDriverPrompt 0: The driver manager displays the ODBC (Open Database Connectivity) Data Sources dialog box. The connection string used to establish the connection is constructed from the data source name (DSN) selected and completed by the user via the dialog boxes. Or, if no DSN is chosen and the DataSourceName property is empty, the default DSN is used. rdDriverNoPrompt 1: The driver manager uses the connection string provided in connect. If sufficient information is not provided, the OpenConnection method returns a trappable error. rdDriverComplete 2: If the connection string provided includes the DSN keyword, the driver manager uses the string as provided in connect, otherwise it behaves as it does when rdDriverPrompt is specified. rdDriverCompleteRequired 3: (Default) Behaves like rdDriverComplete except the driver disables the controls for any information not required to complete the connection. The default value for this class is rdDriverCompleteRequired. See the VBA/VB6 RDO documentation for more information on Options settings.
ReadOnly	Property	Get the value of the ReadOnly property of the current connection. This is a Boolean value that is True if the connection is to be opened for read-only access, and False if the connection is to be opened for read/write access. The default value is False, meaning that the connection is opened for read/write access.
Class_Initialize	Initialize	Set initial values to defaults which may be overridden with property settings.
Class_Terminate	Terminate	Clean up resources.
CloseConnection	Method	Manually closes the connection object and frees resources. This automatically happens when the object variable for this class goes out of scope, but if you want you can close the connection manually with this method.
OpenConnection	Method	Open a connection object based on the connection property settings assigned to this class. This method uses the Connect... properties and the other settings for this class to determine how to open an rdoConnection object. Before calling this method you must specify enough information to open the connection. In general there are two ways to do this: Specify a complete, fully formed Connect string in the ConnectString property of the class. Example: mrdoConnection.ConnectString = "DSN=PUBS;UID=SA;PWD=;DATABASE=PUBS;SERVER=HOTCHA" mrdoConnection.OpenConnection Set the individual properties separately: Set mrdoConnection = New CRDOConnection mrdoConnection.ConnectDSN = "pubs" mrdoConnection.ConnectUserID = "sa" mrdoConnection.ConnectPassword = "" mrdoConnection.ConnectDatabaseName = "pubs" mrdoConnection.OpenConnection This method also returns a pointer to the rdoConnection object created by this method, if you wish to store that pointer separately instead of having to refer to the .Connection property of the class. You may simply ignore the return value, as the above two examples show, or you can save the pointer using code such as the following: Dim cnn As RDO.rdoConnection Set mrdoConnection = New CRDOConnection ' Connect String Properties for DSN-less connection mrdoConnection.ConnectDatabaseName = "pubs" mrdoConnection.ConnectDriver = "{SQL Server}" mrdoConnection.ConnectPassword = "" mrdoConnection.ConnectUserID = "sa" mrdoConnection.ConnectServer = "HOTCHA" ' Connection properties mrdoConnection.Options = rdAsyncEnable mrdoConnection.Prompt = rdDriverNoPrompt mrdoConnection.ReadOnly = False Set cnn = mrdoConnection.OpenConnection() You can now use either the local "cnn" object pointer, or use the .Connection property of the mrdoConnection object. Notice also in the above example that a "DSN-less" connection is created. Because we have supplied enough information for the connection (notably the ConnectDriver and ConnectServer properties) it is not necessary to create an actual file or system DSN on your computer in order to create the connection.
BuildConnectString	Private	Builds a valid Connect string to identify the ODBC data source based on the DSN settings current in the class. This private helper function concatenates values from the Connect... properties of the class into a Connect string used to establish the rdoConnection connection. It is rebuilt when the caller refers to the ConnectString property of the class and just prior to using the OpenConnection method.
m_rdoConnection_BeforeConnect	Private	The private local rdoConnection variable raises connection- related events. This procedure simply passes the BeforeConnect events on to the user of the CRDOConnection class. The BeforeConnect event is fired just before RDO calls the ODBC API SQLDriverConnect function to establish a connection to the server. This event gives your code an opportunity to provide custom prompting, or just provide or capture connection information. The ConnectString parameter is the ODBC connect string RDO will pass to the ODBC API SQLDriverConnect function. This string can be changed during this event, and RDO will use the changed value. For example, your code can provide additional parameters, or change existing parameters of the connect string. The Prompt parameter is the ODBC prompting constant (see the Prompt property). This parameter will default to the value of the Prompt parameter passed in the OpenConnection or EstablishConnection methods. The developer may change this value, and RDO will use the new value when calling SQLDriverConnect.
m_rdoConnection_Connect	Private	The private local rdoConnection variable raises connection-related events. This procedure simply passes the Connect event on to the user of the CRDOConnection class. You can catch the Connect event and do any kind of initial queries required on a new connection, such as verifying the version of the database against the version of the client or setting a default database not established in the connect string. You can also check for errors or messages returned during the process of opening the connection - or perhaps simply clear the rdoErrors collection of informational messages.
m_rdoConnection_Disconnect	Private	The private local rdoConnection variable raises connection-related events. This procedure simply passes the Disconnect event on to the user of the CRDOConnection class. Disconnect is fired after a physical connection is closed. The developer can catch this event to do any clean-up work necessary.
ParseConnectString	Private	Parses the current connect string into its constituent parts and sets the class properties accordingly.

Example Code for Using Class: RDOConnection

' Example of the CRDOConnection and CRDOData classes
'
' To use this example:
' 1. Create a new form.
' 2. Create a reference to RDO 2.0
' 3. Create a command button called 'cmdTestConnection'
' 4. Create a command button called 'cmdTestData'
' 5. Create a command button called 'cmdStoredProcs'
' 6. Paste the entire contents of this module into the new form's module.

Private WithEvents mrdoConnection As CRDOConnection
Private WithEvents mrdoData As CRDOData

Private Sub CreateRDOObjects()

  ' Lay out the controls on the form.
  ' Notice that the command buttons start out disabled. They are enabled when the CRDOConnection object raises the "Connect" event.

  Set mrdoConnection = New CRDOConnection

  With mrdoConnection

    ' Assign parts of the connect string individually
    .ConnectDSN = "pubs"
    .ConnectUserID = "sa"
    .ConnectPassword = ""
    .ConnectDatabaseName = "pubs"

    ' Alternatively, assign the entire connect string manually"
    '   .ConnectString = "dsn=pubs;database=pubs;uid=sa;pwd="

    .Options = rdAsyncEnable
    .Prompt = rdDriverComplete
    .ReadOnly = False
    .CursorDriver = rdUseIfNeeded

    Debug.Print "Open connection asynchronously"
    .OpenConnection

  End With

End Sub

Private Sub cmdTestConnection_Click()

  ' Use the CRDOConnection object which is instantiated during the
  ' form load event to create other objects, such as a resultset:

  Dim rstTemp As RDO.rdoResultset
  Dim strSQL As String

  If mrdoConnection Is Nothing Then
    CreateRDOObjects
  End If

  strSQL = "SELECT fullname = au_lname + ', ' + au_fname " & _
           "FROM authors " & _
           "WHERE au_lname like 'r%' "

  Set rstTemp = mrdoConnection.Connection.OpenResultSet(strSQL, rdOpenForwardOnly, rdConcurReadOnly)

  Debug.Print "--- Use Connection to create resultset"
  Do Until rstTemp.EOF
    Debug.Print vbTab & rstTemp!FullName
    rstTemp.MoveNext
  Loop

  rstTemp.Close
  Set rstTemp = Nothing

End Sub

Private Sub cmdTestData_Click()

  ' These examples demonstrate using queries and opening resultsets
  ' using dynamic SQL rather than stored procedures

  Dim strSQL As String
  Dim rstTemp As RDO.rdoResultset
  Dim varResults As Variant
  Dim lngRowsReturned As Long
  Dim lngRowIx As Long

  If mrdoConnection Is Nothing Then
    CreateRDOObjects
  End If

  'Connection should be open if this button is enabled

  ' Instantiate the CRDOData object if not already created
  If mrdoData Is Nothing Then
    Set mrdoData = New CRDOData

    With mrdoData
      ' Assign a valid RDO connection object.
      ' In this case we are using the Connection property of a CRDOConnection object, but this could be a connection that you create manually
      Set .Connection = mrdoConnection.Connection

    End With

  End If

  ' Create a resultset on a dynamic SQL statement
  Debug.Print "--- Open ResultSet with SQL statement"

  strSQL = "SELECT title " & _
           "FROM titles " & _
           "WHERE (type='business') "

  With mrdoData
    .SQL = strSQL

    ' Create "Firehose cursor"
    .RowsetSize = 1
    .CursorType = rdUseIfNeeded
    .ResultsetType = rdOpenForwardOnly

    .OpenResultSet
    If Not .ResultSet.EOF Then
      Do Until .ResultSet.EOF
        Debug.Print vbTab & .ResultSet!Title
        .ResultSet.MoveNext
      Loop

    End If

  End With

  ' Create a prepared statement query with replaceable parameters, and execute it twice

  strSQL = "SELECT pubdata=city + ': ' + state + ': ' + pub_name " & _
           "FROM publishers " & _
           "WHERE city = ? or state = ?"

  Debug.Print "--- Open ResultSet with parameter query"

  With mrdoData
    .SQL = strSQL
    .AddParameter "pc", "Boston", rdTypeVARCHAR, rdParamInput
    .AddParameter "ps", "TX"

    ' optionally assign created resultset object to a local variable
    Set rstTemp = .OpenResultSet()

    If Not .ResultSet.EOF Then
      Do Until .ResultSet.EOF
        Debug.Print vbTab & .ResultSet!pubdata
        .ResultSet.MoveNext
      Loop

    End If

    Debug.Print "--- Change parameter, and requery"

    ' Change the existing parameter values
    .SetParameterValue "pc", "New York"
    .SetParameterValue "ps", "IL"

    ' Refresh the resultset instead of requerying it so that it uses the same prepared statement query
    .RefreshResultSet

    If Not .ResultSet.EOF Then
      Do Until .ResultSet.EOF
        Debug.Print vbTab & .ResultSet!pubdata
        .ResultSet.MoveNext
      Loop

    End If

  End With

  ' Use GetRows on a resultset

  strSQL = "SELECT au_lname, City " & _
           "FROM authors " & _
           "ORDER BY au_lname"

  With mrdoData
    .ResetParameters
    .SQL = strSQL

    ' Create "Firehose cursor"
    .RowsetSize = 1
    .CursorType = rdUseIfNeeded
    .ResultsetType = rdOpenForwardOnly

    .OpenResultSet

    varResults = .ResultSet.GetRows(100)

  End With

  lngRowsReturned = UBound(varResults, 2) + 1

  Debug.Print "--- Display results from GetRows"

  ' then load up the list box
  For lngRowIx = 0 To lngRowsReturned - 1
    Debug.Print varResults(1, lngRowIx) & ", " & varResults(0, lngRowIx)
  Next lngRowIx

End Sub

Private Sub cmdStoredProcs_Click()

  ' The code in this procedure demonstrates working with Stored procedures and multiple resultsets.
  ' In order to run this code, we must create three stored procedures in your 'pubs' database.

  Dim strMsg As String
  Dim strSQL As String

  If mrdoConnection Is Nothing Then
    CreateRDOObjects
  End If

  strMsg = "This code will create three stored procedures in your pubs database. Continue?"
  If MsgBox(strMsg, vbQuestion + vbYesNo) = vbNo Then

    ' Connection should be open if this button is enabled

    ' Instantiate the CRDOData object if not already created
    If mrdoData Is Nothing Then
      Set mrdoData = New CRDOData

      ' Assign a valid RDO connection object.
      ' In this case we are using the Connection property of a CRDOConnection object, but this could be a connection that you create manually
      Set mrdoData.Connection = mrdoConnection.Connection

    End If

    ' Create fms_PublisherByState stored proc

    strSQL = "SELECT * FROM sysobjects WHERE id = " & _
             "object_id('dbo.fms_PublisherByState') and sysstat & 0xf = 4 "
    mrdoData.ResetParameters
    mrdoData.SQL = strSQL
    mrdoData.OpenResultSet

    ' if not found, create
    If mrdoData.ResultSet.EOF Then

      strSQL = "Create Procedure fms_PublisherByState " & vbCrLf & _
               "  @State1 varChar(2), " & vbCrLf & _
               "  @State2 varChar(2), " & vbCrLf & _
               "  @State3 varChar(2) " & vbCrLf & _
               "As " & vbCrLf & _
               "select   pub_id, pub_name, city, state, country " & vbCrLf & _
               "from     publishers " & vbCrLf & _
               "where    state = @state1 " & vbCrLf & _
               "order by pub_name " & vbCrLf
      strSQL = strSQL & vbCrLf & _
               "select   pub_id, pub_name, city, state, country " & vbCrLf & _
               "from     publishers " & vbCrLf & _
               "where    state = @state2 " & vbCrLf & _
               "order by pub_name " & vbCrLf
      strSQL = strSQL & vbCrLf & _
               "select   pub_id, pub_name, city, state, country " & vbCrLf & _
               "from     publishers " & vbCrLf & _
               "where    state = @state3 " & vbCrLf & _
               "order by pub_name " & vbCrLf & _
              "return (3) "

      Debug.Print "--- Creating stored procedure fms_PublisherByState"

      mrdoData.SQL = strSQL
      mrdoData.Execute True

    Else
      Debug.Print "--- stored procedure fms_PublisherByState already exists"

    End If

    ' Create fms_GetPublishers stored proc

    strSQL = "SELECT * FROM sysobjects WHERE id = " & _
             "object_id('dbo.fms_GetPublishers') and sysstat & 0xf = 4 "

    mrdoData.ResetParameters
    mrdoData.SQL = strSQL
    mrdoData.OpenResultSet

    ' if not found, create
    If mrdoData.ResultSet.EOF Then

      strSQL = "Create Procedure fms_GetPublishers " & vbCrLf & _
              "  @State varChar(2), " & vbCrLf & _
              "  @StateName varChar(20) OUTPUT " & vbCrLf & _
              "As " & vbCrLf & _
              "select @StateName = " & vbCrLf & _
              "case @State " & vbCrLf & _
              "   when 'TX' then 'Texas' " & vbCrLf & _
              "   when 'MA' then 'Massachusetts' " & vbCrLf & _
              "   when 'DC' then 'District of Columbia' " & vbCrLf & _
              "   when 'CA' then 'California' " & vbCrLf & _
              "   when 'IL' then 'Illinois' " & vbCrLf & _
              "   else 'Some Other State' " & vbCrLf & _
              "end " & vbCrLf & _
              "select   pub_id, pub_name, city, state, country " & vbCrLf & _
              "from     publishers " & vbCrLf & _
              "where    state = @state " & vbCrLf & _
              "order by pub_name " & vbCrLf & _
              "return @@ROWCOUNT "

      Debug.Print "--- Creating stored procedure fms_GetPublishers"

      mrdoData.SQL = strSQL
      mrdoData.Execute True

    Else
      Debug.Print "--- stored procedure fms_GetPublishers already exists"

    End If

    ' Create fms_AddPublisher stored proc

    strSQL = "select * from sysobjects where id = " & _
             "object_id('dbo.fms_AddPublisher') and sysstat & 0xf = 4 "

    mrdoData.ResetParameters
    mrdoData.SQL = strSQL
    mrdoData.OpenResultSet

    ' if not found, create
    If mrdoData.ResultSet.EOF Then

      strSQL = "Create Procedure fms_AddPublisher " & vbCrLf & _
               "  @pub_name varChar(20), " & vbCrLf & _
               "  @city varChar(20), " & vbCrLf & _
               "  @state Char(2), " & vbCrLf & _
               "  @country varChar(20), " & vbCrLf & _
               "  @newpubid Char(4) OUTPUT " & vbCrLf & _
               "As " & vbCrLf

      strSQL = strSQL & _
               "declare @maxcurpubid char(4) " & vbCrLf & vbCrLf & _
               "select @maxcurpubid = max(pub_id) " & vbCrLf & _
               "  from publishers " & vbCrLf & _
               " where pub_id > '9900' and pub_id < '9999' " & vbCrLf & vbCrLf & _
               "select @newpubid = convert(char(4),convert(int, @maxcurpubid) + 1) " & vbCrLf & vbCrLf

      strSQL = strSQL & _
               "insert into publishers " & vbCrLf & _
               "  (pub_id, " & vbCrLf & _
               "   pub_name, " & vbCrLf & _
               "   city, " & vbCrLf & _
               "   state, " & vbCrLf & _
               "   country) " & vbCrLf & _
               "values " & vbCrLf & _
               "  (@newpubid, " & vbCrLf & _
               "   @pub_name, " & vbCrLf & _
               "   @city, " & vbCrLf & _
               "   @state, " & vbCrLf & _
               "   @country) " & vbCrLf & vbCrLf & _
               "return (1) "

      Debug.Print "--- Creating stored procedure fms_AddPublisher"

      mrdoData.SQL = strSQL
      mrdoData.Execute True

    Else
      Debug.Print "--- stored procedure fms_AddPublisher already exists"
    End If

    ' Call stored procedure that takes both input parameters and output parameters and creates a resultset

    With mrdoData
      ' disable cursor
      .RowsetSize = 1
      .ResultsetType = rdOpenForwardOnly

      .ResetParameters

      .AddParameter "return", "", rdTypeINTEGER, rdParamReturnValue
      .AddParameter "state", "TX", RDO.rdTypeVARCHAR, rdParamInput
      .AddParameter "statename", "x", rdTypeVARCHAR, rdParamOutput

      ' Call the SP to create the resultset
      .OpenResultSetFromSP "fms_GetPublishers"

      Debug.Print vbTab & "******* Texas publishers"

      If Not .ResultSet.EOF Then
        Do Until .ResultSet.EOF
          Debug.Print vbTab & .ResultSet!pub_name
          .ResultSet.MoveNext
        Loop

      End If

      ' Get any output procedures and return values
      .RetrieveParameters

      Debug.Print vbTab & "statename: " & .GetParameterValue("statename")
      Debug.Print vbTab & "return: " & .GetParameterValue("return")

      ' Modify the parameter
      .SetParameterValue "state", "CA"
      ' Requery the SP
      .RefreshResultSet

      Debug.Print vbTab & "****** California publishers"

      If Not .ResultSet.EOF Then
        Do Until .ResultSet.EOF
          Debug.Print vbTab & .ResultSet!pub_name
          .ResultSet.MoveNext
        Loop

      End If

      ' Retrieve the new output parameters
      .RetrieveParameters

      Debug.Print vbTab & "statename: " & .GetParameterValue("statename")
      Debug.Print vbTab & "return: " & .GetParameterValue("return")

    End With

    ' Call stored procedure that takes both input parameters and output parameters and creates multiple result sets

    With mrdoData
      .ResetParameters

      .AddParameter "return", "", rdTypeINTEGER, rdParamReturnValue
      .AddParameter "state1", "TX"
      .AddParameter "state2", "CA"
      .AddParameter "state3", "IL"

      .RowsetSize = 1
      .OpenResultSetFromSP "fms_PublisherByState"

      Debug.Print vbTab & "*** Multiple RS 1 ***"

      If Not .ResultSet.EOF Then
        Do Until .ResultSet.EOF
          Debug.Print vbTab & .ResultSet!pub_name
          .ResultSet.MoveNext
        Loop

      End If

      If .ResultSet.MoreResults() Then
        Debug.Print vbTab & "*** Multiple RS 2 ***"

        If Not .ResultSet.EOF Then
          Do Until .ResultSet.EOF
            Debug.Print vbTab & .ResultSet!pub_name
            .ResultSet.MoveNext
          Loop

        End If

      End If

      If .ResultSet.MoreResults() Then
        Debug.Print vbTab & "*** Multiple RS 3 ***"

        If Not .ResultSet.EOF Then
          Do Until .ResultSet.EOF
            Debug.Print vbTab & .ResultSet!pub_name
            .ResultSet.MoveNext
          Loop

        End If

      End If

      ' Note that the return parameter is not assigned until all three of the resultsets are consumed
      .RetrieveParameters

      Debug.Print vbTab & "*** Return: " & .GetParameterValue("return")

      Debug.Print vbTab & "Then, after requerying:"
      .SetParameterValue "state1", "MA"
      .SetParameterValue "state2", "NY"
      .SetParameterValue "state3", "DC"

      ' Refresh the resultset, don't create it over again.
      ' This calls the stored procedure from the beginning to get the first resultset in the stored procedure
      mrdoData.RefreshResultSet

      Debug.Print vbTab & "*** Pass 2: Multiple RS 1 ***"

      If Not .ResultSet.EOF Then
        Do Until .ResultSet.EOF
          Debug.Print vbTab & .ResultSet!pub_name
          .ResultSet.MoveNext
        Loop

      End If

      If .ResultSet.MoreResults() Then
        Debug.Print vbTab & "*** Pass 2: Multiple RS 2 ***"

        If Not .ResultSet.EOF Then
          Do Until .ResultSet.EOF
            Debug.Print vbTab & .ResultSet!pub_name
            .ResultSet.MoveNext
          Loop

        End If

      End If

      If .ResultSet.MoreResults() Then
        Debug.Print vbTab & "*** Pass 2: Multiple RS 3 ***"

        If Not .ResultSet.EOF Then
          Do Until .ResultSet.EOF
            Debug.Print vbTab & .ResultSet!pub_name
            .ResultSet.MoveNext
          Loop

        End If

      End If

      ' Note that the return parameter is not assigned until all three of the resultsets are consumed
      .RetrieveParameters

      Debug.Print vbTab & "*** Pass 2: Return: " & .GetParameterValue("return")

    End With

    ' Call stored procedure that takes both input parameters and output parameters but doesn't return a resultset

    Debug.Print "--- Calling sp with input and output parms"

    With mrdoData

      .Connection.BeginTrans

      .ResetParameters

      .AddParameter "return", "", rdTypeINTEGER, rdParamReturnValue
      .AddParameter "pn", "Jims Publishing", rdTypeVARCHAR, rdParamInput
      .AddParameter "pc", "Annandale", rdTypeVARCHAR, rdParamInput
      .AddParameter "ps", "VA", rdTypeCHAR, rdParamInput
      .AddParameter "pcy", "USA", rdTypeVARCHAR, rdParamInput
      .AddParameter "newid", "", rdTypeCHAR, rdParamOutput

      .ExecuteSP "fms_AddPublisher", True

      ' Get output parameter values generated by the sp
      .RetrieveParameters

      Debug.Print vbTab & "Publisher added. ID: " & .GetParameterValue("newid")
      Debug.Print vbTab & "Return: " & .GetParameterValue("return")

      ' Change the parameters and execute again
      .SetParameterValue "pn", "Bobs House O'Books"
      .SetParameterValue "pc", "Boise"
      .SetParameterValue "ps", "ID"
      .SetParameterValue "pcy", "USA"

      ' Rexecute, but use the same rdoQuery object
      .ExecuteSP "fms_AddPublisher", False
      .RetrieveParameters

      .Connection.CommitTrans

      Debug.Print vbTab & "Publisher added. ID: " & .GetParameterValue("newid")
      Debug.Print vbTab & "Return: " & .GetParameterValue("return")

    End With
  End If
End Sub

Private Sub mRDOConnection_BeforeConnect(ConnectString As String, Prompt As Variant)
  Debug.Print "Connect Event: BeforeConnect: " & ConnectString
End Sub

Private Sub mrdoConnection_Connect(ByVal ErrorOccurred As Boolean)

  Debug.Print "Connect Event: Connect: Error? " & ErrorOccurred

  ' Don't enable buttons until the connection is made successfully
  If Not ErrorOccurred Then
    cmdTestConnection.Enabled = True
    cmdTestData.Enabled = True
    cmdStoredProcs.Enabled = True
  End If

End Sub

Private Sub mRDOConnection_Disconnect()
  Debug.Print "Connect Event: Disconnect"
End Sub

Private Sub mRDOData_Associate()
  Debug.Print "Data Event: Associate"
End Sub

Private Sub mRDOData_Dissociate()
  Debug.Print "Data Event: Dissociate"
End Sub

Private Sub mrdoData_QueryComplete(ByVal Query As RDO.rdoQuery, ErrorOccurred As Boolean)
  Debug.Print "Data Event: QueryComplete: Error? " & ErrorOccurred
End Sub

Private Sub mRDOData_QueryTimeout(ByVal Query As RDO.rdoQuery, Cancel As Boolean)
  Debug.Print "Data Event: QueryTimeout"
End Sub

Private Sub mRDOData_ResultsChanged()
  Debug.Print "Data Event: ResultsChanged"
End Sub

Private Sub mRDOData_RowCurrencyChange()
  Debug.Print "Data Event: RowCurrencyChange"
End Sub

Private Sub mRDOData_RowStatusChanged()
  Debug.Print "Data Event: RowStatusChanged"
End Sub

Private Sub mRDOData_WillAssociate(ByVal Connection As RDO.rdoConnection, Cancel As Boolean)
  Debug.Print "Data Event: WillAssociate: Name: " & Connection.name
End Sub

Private Sub mRDOData_WillDissociate(Cancel As Boolean)
  Debug.Print "Data Event: WillDissociate"
End Sub

Private Sub mRDOData_WillExecute(ByVal Query As RDO.rdoQuery, Cancel As Boolean)
  Debug.Print "Data Event: WillExecute"
End Sub

Private Sub mRDOData_WillUpdateRows(ReturnCode As Integer)
  Debug.Print "Data Event: WillUpdateRows: ReturnCode: " & ReturnCode
End Sub

Overview of Total Visual SourceBook

The source code in Total Visual Sourcebook includes modules and classes for Microsoft Access, Visual Basic 6 (VB6), and Visual Basic for Applications (VBA) developers. Easily add this professionally written, tested, and documented royalty-free code into your applications to simplify your application development efforts.

Total Visual SourceBook is written for the needs of a developer using a source code library covering the many challenges you face. Countless developers over the years have told us they learned some or much of their development skills and tricks from our code. You can too!