Learn Microsoft Access Advanced Programming Techniques, Tips and Tricks.

MS-Access Recordset and Class Module


Here, we will build a Class Module for data processing tasks, a DAO.Recordset Object will be passed to the Custom Class Object.  Since it is an Object, that is passed to our Custom Class, we need the Set and Get Property Procedure pair to assign and retrieve the Object or its Property values.

We have a small Table: Table1, with a few records on it.  Here is the image of Table1.

The above table has only four fields: Desc, Qty, UnitPrice, and TotalPrice.  The TotalPrice field is empty.

  • One of the tasks of our Class Module is updating the TotalPrice field with the product of Qty * UnitPrice.

  • The Class Module has a subroutine to sort the data, on the user-specified field, and dumps a listing on the Debug Window.

  • Another subroutine creates a copy of the Table with a new name, after sorting the data based on the column number provided as a parameter.

ClsRecUpdate Class Module.

  1. Open your Access Database and open the VBA Window.

  2. Insert a Class Module.

  3. Change its Name Property Value to ClsRecUpdate.

  4. Copy and Paste the following Code into the Class Module and save the Module:

    Option Compare Database
    Option Explicit
    Private rstB As DAO.Recordset
    Public Property Get REC() As DAO.Recordset
       Set REC = rstB
    End Property
    Public Property Set REC(ByRef oNewValue As DAO.Recordset)
    If Not oNewValue Is Nothing Then
       Set rstB = oNewValue
    End If
    End Property
    Public Sub Update(ByVal Source1Col As Integer, ByVal Source2Col As Integer, ByVal updtcol As Integer)
    'Updates a Column with the product of two other columns
    Dim col As Integer
    col = rstB.Fields.Count
    'Validate Column Parameters
    If Source1Col > col Or Source2Col > col Or updtcol > col Then
        MsgBox "One or more Column Number(s) out of bound!", vbExclamation, "Update()"
        Exit Sub
    End If
    'Update Field
    On Error GoTo Update_Err
    Do While Not rstB.EOF
         With rstB
          .Fields(updtcol).Value = .Fields(Source1Col).Value * .Fields(Source2Col).Value
         End With
    Exit Sub
    MsgBox Err & " : " & Err.Description, vbExclamation, "Update()"
    Resume Update_Exit
    End Sub
    Public Sub DataSort(ByVal intCol As Integer)
    Dim cols As Long, colType
    Dim colnames() As String
    Dim k As Long, colmLimit As Integer
    Dim strTable As String, strSortCol As String
    Dim strSQL As String
    Dim db As Database, rst2 As DAO.Recordset
    On Error GoTo DataSort_Err
    cols = rstB.Fields.Count - 1
    strTable = rstB.Name
    strSortCol = rstB.Fields(intCol).Name
    'Validate Sort Column Data Type
    colType = rstB.Fields(intCol).Type
    Select Case colType
        Case 3 To 7, 10
            strSQL = "SELECT " & strTable & ".* FROM " & strTable & " ORDER BY " & strTable & ".[" & strSortCol & "];"
            Debug.Print "Sorted on " & rstB.Fields(intCol).Name & " Ascending Order"
        Case Else
            strSQL = "SELECT " & strTable & ".* FROM " & strTable & ";"
            Debug.Print "// SORT: COLUMN: <<" & strSortCol & " Data Type Invalid>> Valid Type: String,Number & Currency //"
            Debug.Print "Data Output in Unsorted Order"
    End Select
    Set db = CurrentDb
    Set rst2 = db.OpenRecordset(strSQL)
    ReDim colnames(0 To cols) As String
    'Save Field Names in Array to Print Heading
    For k = 0 To cols
       colnames(k) = rst2.Fields(k).Name
    'Print Section
    Debug.Print String(52, "-")
    'Print Column Names as heading
    If cols > 4 Then
       colmLimit = 4
       colmLimit = cols
    End If
    For k = 0 To colmLimit
        Debug.Print colnames(k),
    Next: Debug.Print
    Debug.Print String(52, "-")
    'Print records in Debug window
    Do While Not rst2.EOF
      For k = 0 To colmLimit 'Listing limited to 5 columns only
         Debug.Print rst2.Fields(k),
      Next k: Debug.Print
    Set rst2 = Nothing
    Set db = Nothing
    Exit Sub
    MsgBox Err & " : " & Err.Description, vbExclamation, "DataSort()"
    Resume DataSort_Exit
    End Sub
    Public Sub TblCreate(Optional SortCol As Integer = 0)
    Dim dba As DAO.Database, tmp() As Variant
    Dim tbldef As DAO.TableDef
    Dim fld As DAO.Field, idx As DAO.Index
    Dim rst2 As DAO.Recordset, i As Integer, fldcount As Integer
    Dim strTable As String, rows As Long, cols As Long
    On Error Resume Next
    strTable = rstB.Name & "_2"
    Set dba = CurrentDb
    On Error Resume Next
    Set rst2 = dba.OpenRecordset(strTable)
    If Err > 0 Then
      Set tbldef = dba.CreateTableDef(strTable)
      Resume Continue
      dba.TableDefs.Delete strTable
      GoTo TryAgain
    End If
    On Error GoTo TblCreate_Err
    fldcount = rstB.Fields.Count - 1
    ReDim tmp(0 To fldcount, 0 To 1) As Variant
    'Save Source File Field Names and Data Type
    For i = 0 To fldcount
        tmp(i, 0) = rstB.Fields(i).Name: tmp(i, 1) = rstB.Fields(i).Type
    'Create Fields and Index for new table
    For i = 0 To fldcount
       tbldef.Fields.Append tbldef.CreateField(tmp(i, 0), tmp(i, 1))
    'Create index to sort data
    Set idx = tbldef.CreateIndex("NewIndex")
    With idx
       .Fields.Append .CreateField(tmp(SortCol, 0))
    End With
    'Add Tabledef and index to database
    tbldef.Indexes.Append idx
    dba.TableDefs.Append tbldef
    'Add records to the new table
    Set rst2 = dba.OpenRecordset(strTable, dbOpenTable)
    rstB.MoveFirst 'reset to the first record
    Do While Not rstB.EOF
       rst2.AddNew 'create record in new table
        For i = 0 To fldcount
            rst2.Fields(i).Value = rstB.Fields(i).Value
    rstB.MoveNext 'move to next record
    rstB.MoveFirst 'reset record pointer to the first record
    Set rst2 = Nothing
    Set tbldef = Nothing
    Set dba = Nothing
    MsgBox "Sorted Data Saved in " & strTable
    Exit Sub
    MsgBox Err & " : " & Err.Description, vbExclamation, "TblCreate()"
    Resume TblCreate_Exit
    End Sub

The rstB Property is declared as a DAO.Recordset Object.

Through the Set Property Procedure accepts a Recordset object can be passed to the Class ClsRecUpdate  Object.

The Update() Subroutine accepts three-column numbers (0-based column numbers) as parameters to calculate and update the third parameter column with the product of the first column * second column.

The DataSort() subroutine Sorts the records in ascending order based on the Column Number passed as a parameter. 

The Sorting Column data type must be either Number, Currency, or String.  Other data types are ignored. The Recordset column numbers are 0-based, which means the first column number is 0, the second column is 1, and so on.

A listing of the records will be dumped on the Debug Window.  The listing of fields will be limited to five fields only, if the record source has more than that then the rest of the fields are ignored.

The TblCreate() subroutine will Sort the data, based on the column number passed as a parameter, and creates a Table with a new name.  The parameter is optional, if a column number is not passed as a parameter, then the Table will be sorted on the data in the first column if the data type of the column is a valid type. The original name of the Table will be modified and added with the String “_2” to the original name. If the Source Table name is Table1 then the new table name will be Table1_2.

The Test Program for ClsUpdate.

Let us test the ClsRecUpdate Class Object with a small Program.

The test program code is given below:

Public Sub DataProcess()
Dim db As DAO.Database
Dim rstA As DAO.Recordset

Dim R_Set As ClsRecUpdate
Set R_Set = New ClsRecUpdate

Set db = CurrentDb
Set rstA = db.OpenRecordset("Table1", dbOpenTable)

'send Recordset Object to Class Object
Set R_Set.REC = rstA

'Update Total Price Field
Call R_Set.Update(1, 2, 3) 'col3=col1 * col2

'Sort Ascending Order on UnitPrice column & Print in Debug Window
Call R_Set.DataSort(2)

'Create New Table Sorted on UnitPrice in Ascending Order
Call R_Set.TblCreate(2) 
Set rstA = Nothing
Set db = Nothing
End Sub

You may pass any Recordset to test the Class Object.

You can pass any column numbers for updating a particular column. The column numbers not necessarily be consecutive numbers. But, the third column number parameter is the target column to update. The first parameter is multiplied by the second column parameter to arrive at the result value to update. You may modify the Class Module code to do any other operation you wish to do on the table.

List of All the Links on this Topic.

  1. MS-Access Class Module and VBA
  2. MS-Access VBA Class Object Arrays
  3. MS-Access Base Class and Derived Objects
  4. VBA Base Class and Derived Objects-2
  5. Base Class and Derived Object Variants
  6. Ms-Access Recordset and Class Module
  7. Access Class Module and Wrapper Classes
  8. Wrapper Class Functionality Transformation
  9. Ms-Access and Collection Object Basics
  10. Ms-Access Class Module and Collection Object
  11. Table Records in Collection Object and Form
  12. Dictionary Object Basics
  13. Dictionary Object Basics-2
  14. Sorting Dictionary Object Keys and Items
  15. Display Records from Dictionary to Form
  16. Add Class Objects as Dictionary Items
  17. Update Class Object Dictionary Item on Form

No comments:

Post a Comment

Comments subject to moderation before publishing.




Post Feed


Popular Posts

Blog Archive

Powered by Blogger.


Forms Functions How Tos MS-Access Security Reports msaccess forms Animations msaccess animation Utilities msaccess controls Access and Internet MS-Access Scurity MS-Access and Internet Class Module External Links Queries Array msaccess reports Accesstips WithEvents msaccess tips Downloads Objects Menus and Toolbars Collection Object MsaccessLinks Process Controls Art Work Property msaccess How Tos Combo Boxes Dictionary Object ListView Control Query VBA msaccessQuery Calculation Event Graph Charts ImageList Control List Boxes TreeView Control Command Buttons Controls Data Emails and Alerts Form Custom Functions Custom Wizards DOS Commands Data Type Key Object Reference ms-access functions msaccess functions msaccess graphs msaccess reporttricks Command Button Report msaccess menus msaccessprocess security advanced Access Security Add Auto-Number Field Type Form Instances ImageList Item Macros Menus Nodes RaiseEvent Recordset Top Values Variables Wrapper Classes msaccess email progressmeter Access2007 Copy Excel Export Expression Fields Join Methods Microsoft Numbering System Records Security Split SubForm Table Tables Time Difference Utility WScript Workgroup database function msaccess wizards tutorial Access Emails and Alerts Access Fields Access How Tos Access Mail Merge Access2003 Accounting Year Action Animation Attachment Binary Numbers Bookmarks Budgeting ChDir Color Palette Common Controls Conditional Formatting Data Filtering Database Records Defining Pages Desktop Shortcuts Diagram Disk Dynamic Lookup Error Handler External Filter Formatting Groups Hexadecimal Numbers Import Labels List Logo Macro Mail Merge Main Form Memo Message Box Monitoring Octal Numbers Operating System Paste Primary-Key Product Rank Reading Remove Rich Text Sequence SetFocus Summary Tab-Page Union Query User Users Water-Mark Word automatically commands hyperlinks iSeries Date iif ms-access msaccess msaccess alerts pdf files reference restore switch text toolbar updating upload vba code