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: RDOData in Category SQL Server : SQL Server from Total Visual SourceBook

Class to support client/server operations using Microsoft's Remote Data Objects (RDO) technology with VB6 and VBA.

This class uses an existing rdoConnection to perform queries, create resultsets, execute stored procedures etc. 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 CRDOData class.
Connection	Property	Get a pointer to rdoConnection object that was previously assigned to this property. Assign an rdoConnection object to this property before using the following methods: Execute, ExecuteSP, OpenResultSet, OpenResultSetFromSP, RetrieveParameters. Note: The related CRDOConnection class can be used to create an rdoConnection which can be assigned to the Connection property of this class.
CursorType	Property	Get the type of cursor used when opening a resultset from an rdoQuery SQL statement or stored procedure.
KeysetSize	Property	Get the number of rows in the keyset buffer. The settings for value must be greater than or equal to the RowsetSize property. The KeysetSize property is a value that specifies the number of rows in the keyset for a keyset or dynamic type rdoResultset cursor.
LockType	Property	Get the type of concurrency handling.
MaxRows	Property	Get the maximum number of rows to be returned from a query or processed in an action query. The value ranges from 0 to any number. If value is set to 0, no limit is placed on the number of rows returned (default). Setting the value to a negative number is invalid and is automatically reset to 0. The MaxRows property limits the number of rows processed by the remote server. When MaxRows is set to a value greater than 0, only 'n' rows are processed. When executing a query that returns rows, only the first 'n' rows are returned. When executing an action query, it means that only the first 'n' rows are updated, inserted or deleted. This property is useful in situations where limited resources prohibit management of large numbers of result set rows. By setting MaxRows to 1 on an action query, you can be assured that no more than one row will be affected by the operation.
Options	Property	Get the options used with this class.
QueryTimeout	Property	Get the number of seconds the ODBC driver manager waits before a timeout error occurs when a query is executed. The default QueryTimeout property setting is 30 seconds. When you're accessing an ODBC data source using the OpenResultset or Execute methods, there may be delays due to network traffic or heavy use of the remote server, perhaps caused by your query. Rather than waiting indefinitely, use the QueryTimeout property to determine how long your application should wait before the QueryTimedOut event is fired and your application trips a trappable error. At this point you have the option to continue waiting for another 'n' seconds as determined by the QueryTimeout property, or cancel the query in progress by using the Cancel argument in the QueryTimedOut event procedure. Setting this property to 0 disables the timer so your query will run indefinitely. Setting QueryTimeout to 0 is not recommended for synchronous operations as your application can be blocked for the entire duration of the query. See the VBA/VB6 documentation for more information on how this property affects your query and connection objects.
QueryType	Property	Get the type of rdoQuery object created.
ResultSet	Property	Get a pointer to the local rdoResultSet object that was created with OpenResultSet, or was previously assigned to this property.
ResultsetType	Property	Get the type of rdoResultset cursor created.
RowsetSize	Property	Get the number of rows in an rdoResultset cursor. The upper limit of the RowsetSize is determined by the data source driver. The lower limit for value is 1, and the default value is 100. The RowsetSize property determines how many rows of the keyset are buffered by the application. RDO uses the RowsetSize property to determine how many rows are read into memory with the ODBC SQLExtendedFetch function. Tuning the size of RowsetSize can affect performance and the amount of memory required to maintain the keyset buffer. This property must be set before creating an rdoResultset object with OpenResultSet or OpenResultSetFromSP. For more information about the RowSetSize property, see the VBA/VB6 RDO documentation.
SQL	Property	Get the SQL string used to create the rdoQuery object. The SQL property contains the structured query language statement that determines how rows are selected, grouped, and ordered when you execute a query.
Class_Initialize	Initialize	Set initial values to defaults which may be overridden with property settings.
Class_Terminate	Terminate	Release rdoQuery and rdoResultset resources. Do NOT close the connection, since this was assigned externally.
AddParameter	Method	Add a parameter which will be used subsequently to supply parameters to the rdoQuery object. Parameters MUST be supplied in the same order that they will be used for substitution in a prepared statement query, or as arguments to a stored procedure. Call this method as many times as necessary to supply the parameters needed for your action. The parameter values are saved until you modify them with SetParameterValue or erase all parameters with ResetParameters.
Execute	Method	Execute an action query using the value of the SQL property and the other option settings. This method executes a dynamic SQL action query (INSERT, DELETE, UPDATE and DDL statements such as CREATE TABLE and so forth) based on the SQL property of the class. The action should not return a resultset. Supply parameters to the query with the AddParameter method prior to executing the query. See the AddParameter method for details. If the fRecreateQuery flag is set to True, a new internal rdoQuery object is created based on the current value of the SQL property. If the flag is False, then the SQL property is ignored, and the previously created query is re-executed, after applying any changes to the parameters modified with the SetParameterValue method.
ExecuteSP	Method	Execute a saved SQL stored procedure which performs one or more actions. Supply parameters to the query with the AddParameter method prior to executing the query. Parameters can include a return value from the stored procedure and output parameters (passed by reference) to receive values from the stored procedure. Since the selected stored procedure to execute is specified in the argument to this method, the value in the SQL property is ignored. Based on the name of the stored procedure and any parameter values supplied with AddParameter, an ODBC 'call' statement is constructed.
GetParameterValue	Method	Get the value of the parameter that was previously created with the AddParameter method. Before executing a dynamic query with Execute or OpenResultSet, you may supply parameter values with the AddParameter method. Normally the value of the parameter stays the same value as whatever you assign to it with AddParameter, or how you update it with SetParameterValue. The value returned by GetParameterValue is the same value that was supplied. If you call a stored procedure with the ExecuteSP or OpenResultSetFromSP methods, however, it is possible for the stored procedure to modify the parameters. The parameter might be an 'output' procedure (parameter passed by reference) or it might be a return value from the stored procedure. After executing the stored procedure you can retrieve the changes to the parameters with the RetrieveParameters method. To test the changed value, use this GetParameterValue method. For an example using this technique with the GetParameterValue method, see the information on the AddParameterValue method.
OpenResultSet	Method	Open a rdoResultset object based on the SQL property of the class and any parameters created with the AddParameter method of the class. The type of locking in use, the number of rows returned, what sort of cursor to create and so on, are all determined by the properties of this class that are set prior to calling the OpenResultSet method. The resultset created by this method is made available via the ResultSet property of the class. Refer to the ResultSet property as your local pointer to the rdoResultSet object. To requery the resultset, say after changing parameters with the SetParameterValue method, use the related RefreshResultSet method.
OpenResultSetFromSP	Method	Execute a stored procedure that returns one or more resultsets. This method is similar to the OpenResultSet method, except that the rdoResultSet is created by running a server side stored procedure rather than a local query. Supply parameters to the query with the AddParameter method prior to executing the query. See the AddParameter method for details. Parameters may include a return value from the stored procedure and output parameters (passed by reference) to receive values from the stored procedure. Since the stored procedure is specified in the argument to this method, the value in the SQL property is ignored. Based on the name of the stored procedure and any parameter values supplied with AddParameter, an ODBC 'call' statement is constructed. To recreate the recordset created from the stored procedure, possibly after changing parameter values with the SetParameterValue method, use the RefreshResultSet method.
RefreshResultSet	Method	Rerun a query that created a result set previously. If parameter values have changed, the query uses them before requerying the resultset. When you use the OpenResultSet and OpenResultsetFromSP methods, an internal rdoQuery object is created and supplied with parameters, if any, that are created with the AddParameter method. Once the rdoQuery object has been created, it is more efficient to re-execute it than to recreate it. Using RefreshResultSet causes the same rdoQuery object to recreate the resultset after applying any changed parameter values.
ResetParameters	Method	Erase the existing parameters. Parameters established with the AddParameter method or modified with the SetParameterValue method remain in effect until you change them. The parameters may be reused multiple times, but need to be cleared to eliminate them for the next SQL or stored procedure.
RetrieveParameters	Method	Retrieve any output parameters or stored procedure return values that were updated by the server. When a stored procedure is executed, it may provide return values assigned to parameters specified by the AddParameter method. It may also alter one of the parameters passed to it (this is known as an "output" parameter or one passed by reference). Parameter values altered or returned by a stored procedure are not automatically reflected into the local parameters set with this class. To update the parameter values so they may be read back with the GetParameterValue method, you must call the RetrieveParameters method. Because a stored procedure may return more than one resultset, may not change an output parameter until the end of the procedure, or set the Return value as the last step, this class cannot automatically know when the parameter values or return values change. You must call the RetrieveParameters method at the appropriate time based on what the stored procedure does.
SetParameterValue	Method	Modify the value of a parameter that was created with the AddParameter method to recreate the resultset or re-execute an action query. You cannot change the data type of the parameter with this method. This method also does not change the order in which the parameters are evaluated.
ApplyParameters	Private	Apply the parameters added with the AddParameter method to the rdoQuery object. Prior to executing a query with Execute or ExecuteSP, or prior to creating a recordset with OpenResultSet or OpenResultSetFromSP, apply any parameters that may have been set with AddParameter, or modified with SetParameterValue, to the internal rdoQuery object.
CreateODBCCallStatement	Private	Format a valid ODBC call statement for use with stored procedures. The elements in the private array maParameters are used to specify the parameters to include in the statement. When executing a stored procedure with the ExecuteSP or OpenResultSetFromSP methods, an ODBC call statement is formatted, and parameter values are inserted into it. This call statement is used to execute the stored procedure.
m_rdoConnection_QueryComplete	Private	The private local m_rdoConnection variable raises connection related events. This procedure passes the QueryComplete event to the user of the CRDOData class. This occurs after the query of an rdoResultset returns the first result set. You can use this event as a notification that the result set is now ready for processing. The QueryComplete event fires for all queries executed on the class's private rdoConnection object. This includes queries executed via the OpenResultset or Execute methods, and those executed from an associated rdoQuery object. The Query argument is an object reference indicating which query just finished executing. Using this argument, you can write a single event handler for all queries on the connection, but still customize the handler for specific queries. When executing queries against the rdoConnection object, RDO creates an rdoQuery object internally and a reference to this internal rdoQuery is passed as the Query argument. This event should be used instead of polling the StillExecuting property to test for completion of OpenResultset or Execute method queries.
m_rdoConnection_QueryTimedOut	Private	The private local m_rdoConnection variable raises connection related events. This procedure simply passes the QueryTimedOut event on to the user of the CRDOData class. This event fires each time the QueryTimeout time is reached. This event is fired on both asynchronous and synchronous queries. You can use this method to display a message box to the user asking them if they wanted to cancel the query or continue to wait. The QueryTimedOut event fires for all queries executed on this rdoConnection via the OpenResultset or Execute methods, and associated rdoQuery object. The Query argument is an object reference indicating which query just timed out. Using this argument, you can write a single event handler for all queries on the connection, but still customize the handler for specific queries. When executing queries against the rdoConnection object, RDO creates an rdoQuery object internally and a reference to this internal rdoQuery is passed as the Query argument.
m_rdoConnection_WillExecute	Private	The private local m_rdoConnection variable raises connection related events. This procedure simply passes the WillExecute event on to the user of the CRDOData class. The WillExecute event fires for all queries executed on this rdoConnection including queries executed via the OpenResultset or Execute methods, and rdoQuery object. Trap this event to disallow the execution of certain queries, or to make last minute adjustments to the rdoQuery object's SQL string. The Query argument is an object reference indicating which query is about to execute. Using this argument, you can write a single event handler for all queries on the connection, but still customize the handler for specific queries. When executing queries against the rdoConnection object, RDO creates an rdoQuery object internally and a reference to this internal rdoQuery is passed as the Query argument.
m_rdoResultSet_Associate	Private	The private local m_rdoResultSet variable raises Resultset related events. This procedure simply passes the Associate event on to the user of the CRDOData class. Use this event to initialize the new connection. The ActiveConnection property of the associated rdoResultset object refers to the new connection. For example, you can use the Associate event procedure to send a special query each time a connection is established, but before other operations are executed.
m_rdoResultSet_Dissociate	Private	The private local m_rdoResultSet variable raises Resultset related events. This procedure simply passes the Dissociate event to the user of the CRDOData class. This event is raised after the ActiveConnection property is set to Nothing and the resultset is dissociated from its connection.
m_rdoResultSet_ResultsChanged	Private	The private local m_rdoResultSet variable raises Resultset related events. This procedure simply passes the ResultsChanged event on to the user of the CRDOData class. This event is raised after the MoreResults method completes and a new set of rows is loaded into the result set. This event is fired even if there are no more sets and the MoreResults method returns False.
m_rdoResultSet_RowCurrencyChange	Private	The private local m_rdoResultSet variable raises Resultset related events. This procedure simply passes the RowCurrencyChange event on to the user of the CRDOData class. This event is raised after the result set is repositioned to a new row or moved to either BOF or EOF. Any of the Move methods, the AbsolutePosition, PercentPosition, or Bookmark properties, or the Requery, MoreResults, or Update (after an AddNew) methods can reposition the row and fire the RowCurrencyChange event. The current position is determined by the AbsolutePosition, PercentPosition, or Bookmark properties of the object. The RowCurrencyChange event can be used to execute a detail query when an associated master row currency changes. For example, if you setup a form containing a master customer record, and a set of rows corresponding to customer orders, you can use the RowCurrencyChange event to launch a query that returns all associated order information each time the user chooses another master customer record. Note: The order the RowCurrencyChange and Reposition events fire cannot be predicted.
m_rdoResultSet_RowStatusChanged	Private	The private local m_rdoResultSet variable raises Resultset related events. This procedure simply passes the RowStatusChanged event on to the user of the CRDOData class. This event is raised after the status of the current row data changes. The status of a row may change due to an Delete, or Update operation. The current status for the row can be determined using the Status property of the object.
m_rdoResultSet_WillAssociate	Private	The private local m_rdoResultSet variable raises Resultset related events. This procedure simply passes the WillAssociate event on to the user of the CRDOData class. This event is raised after setting the ActiveConnection property to a valid rdoConnection object, but before the actual association is made.
m_rdoResultSet_WillDissociate	Private	The private local m_rdoResultSet variable raises Resultset related events. This procedure simply passes the WillDissociate event on to the user of the CRDOData class. This event occurs before the connection is set to nothing.
m_rdoResultSet_WillUpdateRows	Private	The private local m_rdoResultSet variable raises Resultset related events. This procedure simply passes the WillUpdateRows event on to the user of the CRDOData class. The WillUpdateRows event is raised before updated, new and deleted rows are committed to the server. Override the update behavior of the cursor by responding to this event and perform your own updates using stored procedures or any other mechanism you choose. If the result set is using batch optimistic concurrency, this event is only raised when the BatchUpdate method is called. In this case, the entire set of changes is about to be transmitted to the server. If the result set is not in a batch mode, the WillUpdateRows event is raised for each call to the Update method, since the changes for that row are immediately sent to the server.
SetUpQueryObject	Private	Instantiate the private rdoQuery object and set its properties based on the properties exposed in this class. This is an internal helper function which creates the local rdoQuery object that is used to execute queries, take parameters, and open resultsets. It may be based on the stored procedure name or value of the SQL property of the class.

Example Code for Using Class: RDOData

' 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()

  If mrdoConnection Is Nothing Then
    CreateRDOObjects
  End If

  ' 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

  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!