Learn Microsoft Access Advanced Programming Techniques, Tips and Tricks.

User Defined Data Type

Introduction.

VBA has several predefined data types like Integer, String, Date, and so on to use in Programs.  These can be used to hold only one type of data in them.  The Integer Variable can hold Numeric Values ranging from -32768 to +32767, and the String Type stores the Alpha Numeric Values and so on.

But, Programmers can define their own data Type with a mix of all these predefined data types and use it in their programs.  We are going to try this out with a simple example.

Creating a User-Defined Type.

  1. Open one of your existing databases or create a new one.
  2. Open the VBA Editing Window (Alt+F11  or Tools- ->Macro - -> VBA Editing)

    Access2007:

    • Select Modules from the Object drop-down list.
    • Double-click on an existing Module or select Create Menu.
    • Select the Macro- ->Modules Toolbar button to create a new Standard Module.
  3. Copy and paste the following Code into the Module.

    Public Type WagesRec
        strName As String
        dblGrossPay As Double
        dblTaxRate As Double
        dblNetPay As Double
        booTaxPaid As Boolean
    End Type
    
    Public Function WagesCalc()
    Dim netWages As WagesRec, strMsg As String
    Dim fmt As String
    
    With netWages
    .strName = InputBox("Employee Name: ", , "")
    .dblGrossPay = InputBox("Enter Gross Pay:", , 0)
    .dblTaxRate = InputBox("Enter Taxrate", , 0)
    
    .dblNetPay = .dblGrossPay - (.dblGrossPay * .dblTaxRate)
    
    If .dblTaxRate <> 0 Then
       .booTaxPaid = True
    End If
    
    'Display Record
    fmt = "#,##0.00"
    strMsg = "Name:     " & .strName & vbCr & "Grosspay:     " & Format(.dblGrossPay, fmt) & vbCr
    strMsg = strMsg & "Tax Rate:     " & Format(.dblTaxRate * 100, fmt) & "%" & vbCr & "Tax Amt.:     " & Format(.dblGrossPay * .dblTaxRate, fmt) & vbCr
    strMsg = strMsg & "Net Pay:      " & Format(.dblNetPay, fmt) & vbCr & "Tax Paid:     " & .booTaxPaid
    
    MsgBox strMsg, , "WagesCalc()"
    
    End With
    
    End Function
  4. Place the insertion point somewhere in the middle of the WagesCalc() Function and press the F5 Key to run the Code.
  5. Key in the name of the Employee, Gross Pay, and Tax Rate Values when prompted for them.

The output display of the program  is shown below:


The Type Declaration and Properties.

Let us examine the above Code.  The User-defined data type declaration is made at the global area of a Standard Module within the Type WagesRec. . .End Type structure.  WagesRec is an arbitrary name; it can be anything that you like, but it should follow the Variable naming conventions.  By default, the scope of the data type is Public i.e. We can declare a variable using the new data type in Standard Modules and Class Modules as well.  When it is declared as Private; like Private Type WagesRec. . .End Type the scope of the data type is within that module only.

The individual element's name of the new data type should also follow the normal variable naming conventions.

We have declared a Variable NetWages (you can take NetWages, as an Object having several properties that can be set with values) using the new data type WagesRec in our WagesCalc() Function. Individual elements of the NetWages Variable can be addressed as a subset of that object; both separating with a dot (.) like Netwages.dblGrossPay to set its value or retrieve its contents.

We have used three InputBox statements to ask the user to input values for the Name, Grosspay, Tax Rate, calculates the Tax Value, Net Payable amount, and set the Tax Paid flag if Tax Rate is a non-zero value.

Next part of the program, we have loaded a String Variable strMsg with the output labels and values to display them through a MsgBox.


Array Data Type Elements.

In the above Type declaration example, we have used the predefined System data types as elements.  Besides that, we can declare Subscripted Elements and other User-Defined Data Type also as elements,  like the following example:

Public Type MyRecord

     dblIncentives(1 to 100) as double

     EmployeeRec as WagesRec

End Type

In our program let us assume that we have declared a variable with the above data type like the following:

 Dim EmployeeWages as MyRecord

Addressing the individual elements and their sub-elements will be as follows to assign values to them:

EmployeeWages.dblIncentives(1) = 5000

EmployeeWages.EmployeeRec.strName = "John Smith"

Subscripted Variable.

But the whole Data Type can be declared as a Subscripted Variable like:

Dim EmployeeWages(1 to 100) as MyRecord

Then how do we address the individual elements of the Variable?

EmployeeWages(1).dblIncentives(1) = 500

EmployeeWages(1).dblIncentives(2) = 750

EmployeeWages(1).EmployeeRec.strName = "John Smith"

EmployeeWages(1).EmployeeRec.dblGrossPay = 15000

EmployeeWages(2).dblIncentives(1) = 400

EmployeeWages(2).dblIncentives(2) = 450

EmployeeWages(2).EmployeeRec.strName = "George"

EmployeeWages(2).EmployeeRec.dblGrossPay = 17000

Sorting the Array of User-Defined Types.

We will see another example that uses subscripted user-defined data types.  In this example, we will declare a new Data Type for the Employees Table from the Northwind.mdb sample database.  We will load a few field values of the Employees Table into our User Defined Subscripted Variable, sort the Names in memory, and print the output in the Debug Window.

1. Import the Employees Table from C:\Program Files\Microsoft Office\Office11\Samples\Northwind.mdb sample database.

2.  Copy and Paste the following VBA Code into a new Standard Module and save the Module:

Type PersonalRecord
    strFirstName As String
    strLastName As String
    dtDB As Date
    strAddress As String
    strCity As String
    strPostalCode As String
End Type


Public Function ReadSort()
Dim PRec() As PersonalRecord, PRecX As PersonalRecord
Dim db As Database, rst As Recordset, recCount As Long
Dim J As Long, k As Long, h As Long

Set db = CurrentDb
Set rst = db.OpenRecordset("Employees", dbOpenDynaset)
rst.MoveLast
recCount = rst.RecordCount

ReDim PRec(1 To recCount) As PersonalRecord
rst.MoveFirst
J = 0
'Load Employee Records into Userdefined Variable Array
Do While Not rst.EOF
J = J + 1
With rst
    PRec(J).strFirstName = ![FirstName]
    PRec(J).strLastName = ![LastName]
    PRec(J).dtDB = ![BirthDate]
    PRec(J).strAddress = ![Address]
    PRec(J).strCity = ![City]
    PRec(J).strPostalCode = ![PostalCode]
End With
rst.MoveNext
Loop

rst.Close
Debug.Print "Before Sorting"
Debug.Print "--------------"
DisplayRoutine PRec()

'Bubble Sort on FirstName
For k = 1 To J - 1
   For h = k + 1 To J
       If PRec(h).strFirstName < PRec(k).strFirstName Then
           'Swap the Records
           'move the first record to temporary storage area
           PRecX.strFirstName = PRec(k).strFirstName
           PRecX.strLastName = PRec(k).strLastName
           PRecX.dtDB = PRec(k).dtDB
           PRecX.strAddress = PRec(k).strAddress
           PRecX.strCity = PRec(k).strCity
           PRecX.strPostalCode = PRec(k).strPostalCode
        
           'move the second record to replace the first
           PRec(k).strFirstName = PRec(h).strFirstName
           PRec(k).strLastName = PRec(h).strLastName
           PRec(k).dtDB = PRec(h).dtDB
           PRec(k).strAddress = PRec(h).strAddress
           PRec(k).strCity = PRec(h).strCity
           PRec(k).strPostalCode = PRec(h).strPostalCode
           
           'move the from temporary storage to replace the second record
           PRec(h).strFirstName = PRecX.strFirstName
           PRec(h).strLastName = PRecX.strLastName
           PRec(h).dtDB = PRecX.dtDB
           PRec(h).strAddress = PRecX.strAddress
           PRec(h).strCity = PRecX.strCity
           PRec(h).strPostalCode = PRecX.strPostalCode
        End If
    Next h
Next k

Debug.Print "After Sorting"
Debug.Print "--------------"
DisplayRoutine PRec()

End Function


Public Function DisplayRoutine(ByRef getRecord() As PersonalRecord)
Dim RecordCount As Long, J As Long

RecordCount = UBound(getRecord)
For J = 1 To RecordCount
   Debug.Print getRecord(J).strFirstName, getRecord(J).strLastName, getRecord(J).dtDB
Next
Debug.Print
Debug.Print

End Function

3.  Place the insertion point in the middle of the Module and press F5 to run the Code.

4.  Press Ctrl+G to display the Debug Window and you will find the following output printed there:

Before Sorting
--------------
Nancy         Davolio       08/09/1968 
Andrew        Fuller        19/02/1952 
Janet         Leverling     30/08/1963 
Margaret      Peacock       19/09/1958 
Steven        Buchanan      04/03/1955 
Michael       Suyama        02/07/1963 
Robert        King          29/05/1960 
Laura         Callahan      09/01/1958 
Anne          Dodsworth     02/07/1969 


After Sorting
--------------
Andrew        Fuller        19/02/1952 
Anne          Dodsworth     02/07/1969 
Janet         Leverling     30/08/1963 
Laura         Callahan      09/01/1958 
Margaret      Peacock       19/09/1958 
Michael       Suyama        02/07/1963 
Nancy         Davolio       08/09/1968 
Robert        King          29/05/1960 
Steven        Buchanan      04/03/1955 

How it Works.

  1. At the beginning part of the program, we opened the Employees Table, read the count of records in the Table, and accordingly, we re-dimensioned the user-defined variable PersonalRecord to reserve enough space to hold all the Employees records.
  2. Next, we opened the Employees Table and loaded all the employees' data into the array.
  3. We have sent a list of the unsorted data in the Debug Window.
  4. The data is sorted in Ascending Order on FirstName in memory using the Bubble-Sort method.
  5. The sorted employee records are listed in the Debug Window again.

Tip:  You can change the sorting order in Descending order by changing the logical operator < to > in the following statement:

If PRec(h).strFirstName < PRec(k).strFirstName Then

If PRec(h).strFirstName > PRec(k).strFirstName Then

 As you can see, the data printing Routine is a separate Function Display Routine() and we have passed the whole Array of records to this program twice to print its contents into the Debug Window.

Share:

No comments:

Post a Comment

Comments subject to moderation before publishing.

PRESENTATION: ACCESS USER GROUPS (EUROPE)

Translate

PageRank

Post Feed


Search

Popular Posts

Blog Archive

Powered by Blogger.

Labels

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