Class Object use and workflow (1 Viewer)

GBalcom · Mar 28, 2017

I'm trying to implement classes into my programs more. One of the things I'm struggling with is simple logic. How do you know when something is accomplished?

A simple example of is a light switch. Typically I may have a function within a standard module to turn on said light switch. This function could be a sub, but I would make it a function that returns a boolean. This would return false if anything went wrong so that my program knew it failed and acted accordingly.

Now, in a class object, I'm trying to use a Let Property of the same light switch. Say it's a Voltage property I'm trying to set. How do I know back at my calling procedure if that property was changed correctly or if it failed?

In my real case, that class property is creating an update transaction within our db. I need to know if it went through properly or not.

MarkK · Mar 28, 2017

Hi. What is your code? What is the call you make to the class? What is the property let procedure? For a simple on/off status I would do...

Code:

private m_state as boolean

property get IsOn as boolean
   IsOn = m_state
end property
property let IsOn(state as boolean)
   m_state = state
end property

...but then the test for success is obvious, just read the property value. How does your requirement differ from this?

GBalcom · Mar 28, 2017

Thanks for the quick response Mark.

Here's my calling procedure

Code:

Private Sub cmdReadyStatus_Click()   

    On Error GoTo PROC_ERR


'change status
Dim clWo As clsWorkOrder
Set clWo = New clsWorkOrder
    clWo.WorkOrderID = Me.WoNbr
    clWo.StatusID = 3
'cleanup
Set clWo = Nothing 
    

PROC_EXIT:
    Exit Sub

PROC_ERR:
    MsgBox Err.Description, vbCritical, Me.Name & ".cmdReadyStatus_Click"
    Resume PROC_EXIT
    Resume


End Sub

Here's my Class Property:

Code:

Public Property Let StatusID(NewValue As Long)
    

    On Error GoTo PROC_ERR


'Test to make sure new value is an integer, between 0 and 9, and not 4.
If (Int(NewValue) = NewValue) And NewValue <= 9 And NewValue >= 0 And NewValue <> 4 Then
    'prepare SQL statement
    Dim strSQL As String
    strSQL = "Update WO set WorkOrdStatusNbr = " & NewValue & " where WoNbr = " & m_lngWorkOrderID & ";"

    'update
    If UpdateWo(strSQL) Then
        'successful transaction, continue

    End If
    
    
End If





PROC_EXIT:
    Exit Property

PROC_ERR:
    Err.Raise Err.Number


End Property

MarkK · Mar 28, 2017

Well, you can raise a custom error, as you do in your error handler. See how in your error handler you just re-raise errors that might occur in your routine? So....

Code:

[COLOR="Green"]    'update[/COLOR]
    If Not UpdateWo(strSQL) Then
[COLOR="Green"]        'unsuccessful transaction, don't continue[/COLOR]
        err.raise -1, "Let clsWorkOrder.StatusID", "StatusID table update failed."
    End If

...but you can add various indicator members to your class too, like...

Code:

private m_hasErrors as boolean
private m_errText

property get HasErrors as boolean
   HasErrors = m_hasErrors
end property

property get ErrorText as string
   ErrorText = m_errText
end property

...and then for every error, you do...

Code:

PROC_EXIT:
    Exit Property

PROC_ERR:
    m_hasErrors = true
    m_errText = m_errText & err.Number & " " & err.Description & vbCrLf
[COLOR="Green"]'    Err.Raise Err.Number  'instead of raising this, we record it, and expose it[/COLOR]
    Resume PROC_EXIT

End Property

...and your calling code can do...

Code:

   [COLOR="Green"]'change status[/COLOR]
   with New clsWorkOrder
      .WorkOrderID = Me.WoNbr
      .StatusID = 3
      If .HasErrors then 
         MsgBox .ErrorText, , "Work Order Errors"
[COLOR="Green"]         'deal with errors here[/COLOR]
      End If
   end with

But you also probably want a Property Get for that StatusID too, so maybe you've set the StatusID default value to -1 at the table level, then you might expose a property like...

Code:

Property Get StatusID as Long
   StatusID = Nz(DLookup("StatusID", "WO", "WorkOrderID = " & m_lngWorkOrderID), -1)
End Property

...and then just test the StatusID, like...

Code:

   [COLOR="Green"]'change status[/COLOR]
   with New clsWorkOrder
      .WorkOrderID = Me.WoNbr
      .StatusID = 3
      If .StatusID = -1 then 
[COLOR="Green"]         'the status is still not valid[/COLOR]
      End If
   end with

...and we haven't even talked about raising events from your custom class, to be handled by calling code. So you have to ton of options...

Classes are very powerful but they definitely take some time to get your head around, but congrats to you for going for it!!!

Hope this helps,

GBalcom · Mar 29, 2017

Thanks Mark for the Reply. It's going to take me some time to digest this, and understand it well enough to use it. I think I like the idea of just calling the Get property again to ensure it changed. Perhaps that adds some overhead though? This isn't a property that will get changed often, so maybe it's no big deal.

jdraw · Mar 29, 2017

GBalcom,

There aren't a lot of samples/examples of Access class modules. There are more now than a couple of years ago, but if you have an example showing the class, its usage and don't mind sharing, I think it would be a good addition to the Code repository/Sample databases.

As an aside - I did respond to your rubberduck question.

Frothingslosh · Mar 29, 2017

There's also the "Access OOP Examples Wanted" thread HERE. Several classes are saved there for folks' use.

static · Mar 29, 2017

Add events. Set the value and if the value is updated raise a success or fail event.

class

Code:

Dim thevalue As Integer

Public Event valuechanged()
Public Event valuechangeerror()

Public Property Let value(value As Integer)
    If value < 10 Then
        thevalue = value
        RaiseEvent valuechanged
    Else
        RaiseEvent valuechangeerror
    End If
End Property

Code:

Dim WithEvents cls As Class1

Private Sub Command0_Click()
    Set cls = New Class1
    cls.value = 12
End Sub

Private Sub cls_valuechanged()
    MsgBox "value was changed"
End Sub

Private Sub cls_valuechangeerror()
    MsgBox "value was not changed"
End Sub

GBalcom · Apr 4, 2017

Just an update.
I spent a portion of the weekend going over youtube videos on Classes, Polymorphism, and interfaces. Interfaces are pretty interesting. I could see one area in my work where they might be useful.

I've created two export classes, one exports the data to an excel spreadsheet, the other to XML. The XML was to replace the excel, but the excel export is still useful. If I used an interface for these, then at some point it wouldn't be a big deal to swap to yet another export in the future (JSON, .txt, etc.)

If nothing else that time has given me a different perspective about coding.

jdraw · Apr 4, 2017

Thanks for the update.
If you want to share those classes, I'm sure readers would like to see them.

jdraw · Apr 4, 2017

Frothingslosh,

I'd like to see the sample. It may have been size that forced you to a zip.
I see you have deleted the post since the original message?

Update: I saw your zip on the other thread. OK.

Frothingslosh · Apr 4, 2017

Yeah, I thought this was the OOP thread over in the Theory forum. Click on the link in post 7 and it should be the most recent post on that thread at this moment.

In fact, HERE.

GBalcom · Apr 5, 2017

Frothingslosh,
That's an excellent example! Thank you for sharing it. Your comments within the module cleared up many things for me. I still have a maintenance question though. Let's say you've set up your interface and have 4 classes using it. 6 months later you find out for whatever reason that you really need to add a new method or property to the interface. Do you simply add it to each of the classes that use it, and the interface?

Frothingslosh · Apr 5, 2017

Pretty much. I believe you can add PRIVATE classes as needed to the implementing classes, but the public classes must always be a match.

So any time you need to add an additional public class to one, you need to add it to the rest, even if they don't actually DO anything in the rest.

Edit: Okay, I just checked, and it appears that the procedures that must match the interface class are the ones whose names follow the convention InterfaceName_ProcedureName. You can have any additional PRIVATE procedures you need that don't follow that convention. Technically, it will compile if you add additional public procedures that don't use the convention, but I don't believe you'll actually be able to call them.

I'm afraid I can't test that atm, the cats are all demanding their nightly attention.

jdraw · Apr 6, 2017

Frothingslosh,
I found the post very helpful also. It is clear and will be a good learning tool/template.
Thanks for sharing.

Cronk · Apr 6, 2017

FWIW, I have for some time now, wrapping all my major entity tables into a class. Rather than using DLookups all the time, once the record is in a class variable, a simple objPerson.surname returns the surname. Or objPerson.FullName is a propery which concatenates the first/family names.

I wrote a quick and dirty function to generate the declarations, Let/Get procedures and a simple Load and Save event. The function generates four text files that I copy/paste into the class module.

One of the best outcomes of this is I don't always remember the exact names of fields at times. Intellisense gives me shows me for my class objects.

Code:

Function CreateClass(strTableName)
   On Error Resume Next
   Kill "C:\Temp\Declarations.txt"
   Kill "C:\Temp\GetLet.txt"
   Kill "C:\Temp\LoadMethod.txt"
   Kill "C:\Temp\SaveMethod.txt"
   
   On Error GoTo CreateClass_Err
   
   Dim db As DAO.Database, tdf As DAO.TableDef, fld As DAO.Field, idx As DAO.Index
   Dim strFile1 As String, strFile2 As String
   Dim str1 As String, str2 As String, str3 As String, str4 As String, strKeyField As String
   Dim strVarname As String
   Dim intFileNo1 As Integer, intFileNo2 As Integer, intFileNo3 As Integer, intFileNo4 As Integer
   
   Const SPACE3 = "   "
   Const SPACE6 = "      "
   Const SPACE9 = "         "
   
   intFileNo1 = FreeFile
   Open "C:\Temp\Declarations.txt" For Output As intFileNo1
   
   intFileNo2 = FreeFile
   Open "C:\Temp\GetLet.txt" For Output As intFileNo2
   
   intFileNo3 = FreeFile
   Open "C:\Temp\LoadMethod.txt" For Output As intFileNo3
   
   intFileNo4 = FreeFile
   Open "C:\Temp\SaveMethod.txt" For Output As intFileNo4
   
   Set db = CurrentDb
   Set tdf = db.TableDefs(strTableName)
   
   For Each idx In tdf.Indexes
      If idx.Unique Then
         strKeyField = idx.fields(0).Name
      End If
   Next
   
   str3 = "Function Load()" & vbCrLf & _
      SPACE3 & "Dim db as DAO.Database, rst as DAO.Recordset" & vbCrLf & vbCrLf & _
      SPACE3 & "Set db = Currentdb" & vbCrLf & _
      SPACE3 & "Set rst = db.openrecordset(" & Chr(34) & "SELECT * FROM " & tdf.Name & " WHERE " & strKeyField & " = " & Chr(34) & " & CStr(lng" & strKeyField & ")" & ")" & vbCrLf & _
      SPACE3 & "With rst" & vbCrLf
   
   str4 = "Function Save()" & vbCrLf & _
      SPACE3 & "Dim db as DAO.Database, rst as DAO.Recordset" & vbCrLf & vbCrLf & _
      SPACE3 & "Set db = Currentdb" & vbCrLf & _
      SPACE3 & "Set rst = db.openrecordset(" & Chr(34) & "SELECT * FROM " & tdf.Name & " WHERE " & strKeyField & " = " & Chr(34) & " & CStr(lng" & strKeyField & ")" & ")" & vbCrLf & _
      SPACE3 & "With rst" & vbCrLf & _
      SPACE6 & "If .RecordCount=0 Then" & vbCrLf & _
      SPACE9 & ".AddNew" & vbCrLf & _
      SPACE6 & "Else" & vbCrLf & _
      SPACE9 & ".Edit" & vbCrLf & _
      SPACE6 & "Endif"
   
   Print #intFileNo3, str3
   Print #intFileNo4, str4
   
   For Each fld In tdf.fields
      If fld.Type = dbBoolean Then
         strVarname = "boo" & fld.Name
         str1 = "Private " & strVarname & " As Boolean"
         str2 = "Public Property Get " & fld.Name & "() As Boolean" & vbCrLf & _
            SPACE3 & fld.Name & " = " & strVarname & vbCrLf & _
            "End Property" & vbCrLf & vbCrLf & _
            "Public Property Let " & fld.Name & "(ByVal booNewValue as Boolean)" & vbCrLf & _
            SPACE3 & strVarname & " = booNewValue" & vbCrLf & _
            "End Property" & vbCrLf
      
      ElseIf fld.Type = dbLong Or fld.Type = dbInteger Then
         strVarname = "lng" & fld.Name
         str1 = "Private " & strVarname & " As Long"
         str2 = "Public Property Get " & fld.Name & "() As Long" & vbCrLf & _
            SPACE3 & fld.Name & " = " & strVarname & vbCrLf & _
            "End Property" & vbCrLf & vbCrLf & _
            "Public Property Let " & fld.Name & "(ByVal lngNewValue as long)" & vbCrLf & _
            SPACE3 & strVarname & " = lngNewValue" & vbCrLf & _
            "End Property" & vbCrLf
      
      ElseIf fld.Type = dbDouble Then
         strVarname = "dbl" & fld.Name
         str1 = "Private " & strVarname & " As Double"
         str2 = "Public Property Get " & fld.Name & "() As Double" & vbCrLf & _
            SPACE3 & fld.Name & " = " & strVarname & vbCrLf & _
            "End Property" & vbCrLf & vbCrLf & _
            "Public Property Let " & fld.Name & "(ByVal dblNewValue as Double)" & vbCrLf & _
            SPACE3 & strVarname & " = dblNewValue" & vbCrLf & _
            "End Property" & vbCrLf
      
      ElseIf fld.Type = dbCurrency Then
         strVarname = "cur" & fld.Name
         str1 = "Private " & strVarname & " As Currency"
         str2 = "Public Property Get " & fld.Name & "() As Currency" & vbCrLf & _
            SPACE3 & fld.Name & " = " & strVarname & vbCrLf & _
            "End Property" & vbCrLf & vbCrLf & _
            "Public Property Let " & fld.Name & "(ByVal dblNewValue as Currency)" & vbCrLf & _
            SPACE3 & strVarname & " = dblNewValue" & vbCrLf & _
            "End Property" & vbCrLf
      
      Else
         strVarname = "var" & fld.Name
         str1 = "Private " & strVarname & " As Variant"
         str2 = "Public Property Get " & fld.Name & "() As Variant" & vbCrLf & _
            SPACE3 & fld.Name & " = " & strVarname & vbCrLf & _
            "End Property" & vbCrLf & vbCrLf & _
            "Public Property Let " & fld.Name & "(ByVal varNewValue as Variant)" & vbCrLf & _
            SPACE3 & strVarname & " = varNewValue" & vbCrLf & _
            "End Property" & vbCrLf
      End If
      
      str3 = SPACE6 & strVarname & "= !" & fld.Name
      str4 = SPACE6 & "!" & fld.Name & "= " & strVarname
      
      Print #intFileNo1, str1
      Print #intFileNo2, str2
      Print #intFileNo3, str3
      Print #intFileNo4, str4
      
   Next
   
   str3 = SPACE3 & "End With" & vbCrLf & _
      SPACE3 & "rst.Close:Set rst = nothing" & vbCrLf & _
      SPACE3 & "Set db = nothing" & vbCrLf & _
      "End Function"
   str4 = SPACE6 & ".Update" & vbCrLf & _
      SPACE3 & "End With" & vbCrLf & _
      SPACE3 & "rst.Close:Set rst = nothing" & vbCrLf & _
      SPACE3 & "Set db = nothing" & vbCrLf & _
      "End Function"
      
   Print #intFileNo3, str3
   Print #intFileNo4, str4
   
   Close #intFileNo1
   Close #intFileNo2
   Close #intFileNo3
   Close #intFileNo4
   
   MsgBox "Finished"
   
   Set idx = Nothing
   Set tdf = Nothing
   Set db = Nothing
   
   Exit Function
   
CreateClass_Err:
   MsgBox "An error has occurred"
   Resume
End Function

GBalcom · Apr 6, 2017

Very neat, thanks for sharing.

I'd also like to recommend RubberDuck. Its an open source VBE add in I've been playing with for about a week now. Between it and my FMS code tools, VBE is starting to feel pretty powerful.

I haven't dug into everything RubberDuck has yet, but I've found the code explorer very good for organizing your code as you see fit. The auto indent and the unit tests are great too. There's also a Todo list which is super handy. You simply add a comment of 'TODO anywhere you need to get back to, and it will keep a list of those for you. (As well as 'BUG and 'NOTE and any custom ones you want). Not bad for the price (FREE).

Frothingslosh · Apr 6, 2017

Nice module, Cronk - you should post that in the OOP thread over in the theory forum.

I do notice one very minor issue - the creation script doesn't take AutoNumber into account, so the resulting save procedure will attempt to save the AN field unless you go in and remove that one line.

Making me spend that extra second in preparation if I use it.... *shakes head*

Anyway, that certainly looks handy in certain situations.

Speed-wise, how does this class stack up with DLookup?

jdraw · Apr 6, 2017

Very nice Cronk! As GBalcom and Frothingslosh said -thanks for sharing. I think it would be a great inclusion in the OOP thread.

I'm not experienced enough in class modules to know the significance of the autonumber issue mentioned by Frothingslosh, but if it can be adjusted it would seem more complete (guessing).

I could see using this for multiple tables and perhaps using this sort of code would prevent overwriting the txt files.

Code:

...Dim baseDir As String: baseDir = "C:\users\mellon\documents\"
    On Error Resume Next
    Kill baseDir & strTableName & "Declarations.txt"
    Kill baseDir & strTableName & "GetLet.txt".....

Is there some vba to actually create the class module /import the text files? Is it practical?
Again thanks for sharing.

Frothingslosh · Apr 6, 2017

Meh, it's not a class thing, it's a 'You can't write to an autonumber field in Access' thing. The one second I mentioned is just the time involved in deleting that particular line from his Save method.

There's actually not enough ROI to warrant changing the script to check for AN fields and exclude them from Save, IMO.

Class Object use and workflow (1 Viewer)

Much to learn!

bit cruncher

Much to learn!

bit cruncher

Much to learn!

Super Moderator

Premier Pale Stale Ale

Registered User.

Much to learn!

Super Moderator

Super Moderator

Premier Pale Stale Ale

Much to learn!

Premier Pale Stale Ale

Super Moderator

Registered User.

Much to learn!

Premier Pale Stale Ale

Super Moderator

Premier Pale Stale Ale

Similar threads

Users who are viewing this thread