Group or Nested Classes Examples????

[PianoMan64]

Hey Group,

Wanted to know if anyone has been able code Classes in VBA where you can create a structured group of items for example

PETS.DOGS.NAME

and how would you code that in VBA.

Thanks,

Joe P.

[FishVal]

Hi, Joe.

In class PETS declare property DOGS returning object of class DOGS.

Class module PETS
[code=vb]
Dim objDogs As New DOGS

Public Property Get DOGS() As DOGS
Set DOGS = objDogs
End Property

Public Property Set DOGS(ByVal objNewValue As DOGS)
Set objDogs = objNewValue
End Property
[/code]

Class module DOGS
[code=vb]
Dim strName As String

Public Property Get Name() As String
Name = strName
End Property

Public Property Let Name(ByVal strNewValue As String)
strName = strNewValue
End Property
[/code]

Now an example in some code module
[code=vb]
Public Sub SomeSub()
Dim objPets As New PETS
With objPets.DOGS
.Name = "qqq"
Debug.Print .Name
End With
Set objPets = Nothing
End Sub
[/code]

Regards,
Fish

[PianoMan64]

Thanks a million, that worked perfectly. I've been searching for that for months.

Thanks again,

Joe P.

[ADezii]

Hi, Joe.

In class PETS declare property DOGS returning object of class DOGS.

Class module PETS
[code=vb]
Dim objDogs As New DOGS

Public Property Get DOGS() As DOGS
Set DOGS = objDogs
End Property

Public Property Set DOGS(ByVal objNewValue As DOGS)
Set objDogs = objNewValue
End Property
[/code]

Class module DOGS
[code=vb]
Dim strName As String

Public Property Get Name() As String
Name = strName
End Property

Public Property Let Name(ByVal strNewValue As String)
strName = strNewValue
End Property
[/code]

Now an example in some code module
[code=vb]
Public Sub SomeSub()
Dim objPets As New PETS
With objPets.DOGS
.Name = "qqq"
Debug.Print .Name
End With
Set objPets = Nothing
End Sub
[/code]

Regards,
Fish

Really going to the DOGS, hey FishVal. (LOL).

[FishVal]

Thanks a million, that worked perfectly. I've been searching for that for months.

Thanks again,

Joe P.

Not a problem, Joe.
Good luck.

[FishVal]

Really going to the DOGS, hey FishVal. (LOL).

Just dogging it the whole time. (LOL)

Kind regards,
Fish

[NeoPa]

Just dogging it the whole time. (LOL)

I HOPE that means something different over there than it does over here in Blighty :D

PS. Don't even ask!!

[FishVal]

I HOPE that means something different over there than it does over here in Blighty :D

PS. Don't even ask!!

LOL ???.

Honestly, I've meant that I was writing this while I was supposed to do some other important job (so what?). Does that mean something substantially else over there in Blighty? Anyway you've quoted it as bold and underlined, so it isn't a bad word itself. ;) I've got it from ABBYY Lingvo.

[Scott Price]

Means different things on different sides of the big pond :-)

Great work on the class example, Fish!

Regards,
Scott

[NeoPa]

I wasn't criticising Fish. Far from it. Just having a laugh at the wording (which is a little less innocent here than it probably is for you) :D

[FishVal]

I wasn't criticising Fish. Far from it. Just having a laugh at the wording (which is a little less innocent here than it probably is for you) :D

And I didn't take it as criticism. :P
I've referred with ABBYY Lingvo again. Really deserves LOL. I've used American slang meaning while British slang meaning is completely other. :D
The funny thing here is that yesterday I had a discussion with my boss concerning differences in English spoken in different countries (or even regions). Now it less seems me he was exaggerating. LOL.

Kind regards.
Fish

[PianoMan64]

Really going to the DOGS, hey FishVal. (LOL).

Hello all,

I have one more question in regards to the Class Collection, I'm trying to include custom events within the classes. What would be my best approach?

Since I've already tried to implement them, the problem that I'm having is I'm not able to use the NEW option when defining the variable that are going to hold the objects for the sub-classes. Example:

'Old Statement
 
Dim Techs as new clsTechsV2
Dim Teams as new clsTeamsV2
 
 
'Added withevents
Dim withevents Techs as clsTechsV2
Dim withevents Teams as clsTeamV2

Since I'm getting the error message "Runtime Error 91 - Object variable, or With block not set"?

Is there a way around this, or some kind of remedy.

Below is a code snippet:

Class Name BatchClass

Dim WithEvents Techs As clsTechV2
Dim WithEvents Teams As clsTeamV2
 
Public Property Get Tech() As clsTechV2
    Set Tech = Techs
End Property
Public Property Get Team() As clsTeamV2
    Set Team = Teams
End Property

Class Name "clsTechV2"

Public Event TechError(ErrNumber As Integer, ErrDescription As String)
 
Public Function GetTechInfo() As Boolean
    Set cn = New ADODB.Connection
    Set cmd = New ADODB.Command
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim DestroyedRS As ADODB.Recordset
    Dim DestroyedBLV As ADODB.Recordset
    Dim FNVPending As ADODB.Recordset
    Dim BLVHours As ADODB.Recordset
    Dim TechSchedule As ADODB.Recordset
    Dim FNVCurrentPending As ADODB.Recordset
    Dim TechProcImages As ADODB.Recordset
    Dim TodaysCounts As ADODB.Recordset
    Dim TodaysBLVHours As ADODB.Recordset
 
    Dim strSQL As String
    On Error GoTo Err_GetTechInfo
    If Len(in_ScanTechName) < 1 Then
        'MsgBox "Must set ScanTechName, StartDate, EndDate, and Location before calling GetTechInfo.", vbCritical + vbOKOnly
        RaiseEvent TechError(1, "Must set ScanTechName Property before calling GetTechInfo.")
        GetTechInfo = False
        Exit Function
    End If
    If in_StartDate < 1 Then
        'MsgBox "Must Define valid date value in StartDate before calling GetTechInfo.", vbCritical + vbOKOnly
        RaiseEvent TechError(2, "Must set StartDate Property before calling GetTechInfo Method.")
        GetTechInfo = False
        Exit Function
    End If
    If in_EndDate < 1 Then
        'MsgBox "Must Define valid date value in EndDate before calling GetTechInfo.", vbCritical + vbOKOnly
        RaiseEvent TechError(3, "Must set EndDate Property before calling GetTechInfo Method.")
        GetTechInfo = False
        Exit Function
    End If
    If Len(in_Location) < 1 Then
        'MsgBox "Must set Location value before calling GetTechInfo.", vbCritical + vbOKOnly
        RaiseEvent TechError(4, "Must set Location property before calling GetTechInfo Method.")
        GetTechInfo = False
        Exit Function
    End If
    If Len(in_FNVRate) < 1 Then
        'MsgBox "Must Define FNVRate Variable.", vbCritical + vbOKOnly
        RaiseEvent TechError(5, "Must set FNVRate property before calling GetTechInfo Method.")
        GetTechInfo = False
        Exit Function
    End If
    If Len(in_ProductionRate) < 1 Then
        'MsgBox "Must define ProductionRate Variable.", vbCritical + vbOKOnly
        RaiseEvent TechError(6, "Must set ProductionRate property before calling GetTechInfo Method.")
        GetTechInfo = False
        Exit Function
    End If

Class Name "clsTeamV2"

Public Event TeamError(ErrNumber As Integer, ErrDescription As String)
 
Public Function GetTeamStats() As Boolean
    Dim rs As ADODB.Recordset
    Dim DestroyedRS As ADODB.Recordset
    Dim BLVHours As ADODB.Recordset
    Dim ProdHoursRS As ADODB.Recordset
    Dim NonProdHoursRS As ADODB.Recordset
    Dim TeamProdHoursRS As ADODB.Recordset
    Dim TeamNonProdHoursRS As ADODB.Recordset
    Dim TeamSchedule As ADODB.Recordset
    Dim TeamLineOfBusiness As ADODB.Recordset
    Dim TeamCosts As ADODB.Recordset
    Dim TeamProcImages As ADODB.Recordset
    Dim TeamCount As ADODB.Recordset
    Dim TeamProdDays As ADODB.Recordset
    Dim strSQL As String
    Set cmd = New ADODB.Command
    Set cnx = New ADODB.Connection
With cnx
      .Provider = "MSDAORA"
      .Properties("Data Source").Value = "EU"
      .Properties("User ID").Value = "PRESUSER"
      .Properties("Password").Value = "WASHINGTON"
      .Open
End With
    'Set ec = New clsErrorChecks
    'Error Checking to make sure that Team Name and Start and End Dates are set
    If IsNull(tm_TeamName) Or Len(tm_TeamName) < 1 Then
        'MsgBox "Must Set Team Name Before Calling GetTeamStats Function.", vbCritical + vbOKOnly
        RaiseEvent TeamError(1, "TeamName Value not Defined. Must set TeamName property before calling GetTeamStats Method.")
        GetTeamStats = False
        Exit Function
    End If
    If tm_StartDate <= 1 Then
        'MsgBox "Must Set a valid Starting Date before calling GetTeamStats Function.", vbCritical + vbOKOnly
        RaiseEvent TeamError(2, "StartDate Value not Defined. Must set StartDate Property before calling GetTeamStats Method.")
        GetTeamStats = False
        Exit Function
    End If
    If tm_EndDate <= 1 Then
        'MsgBox "Must Set a valid Ending Date before calling GetTeamStats Function.", vbCritical + vbOKOnly
        RaiseEvent TeamError(3, "EndDate property not defined. Must set EndDate Property before calling GetTeamStats Method.")
        GetTeamStats = False
        Exit Function
    End If

Thanks for any help someone could provide.

Joe P.

[FishVal]

Hello, Joe.

Really, object variable could not be declared using New with events to get it instantiated automatically when needed.
You need to instantiate it manually via
Set objDeclaredWith Events = New clsClassRaising Event
before first use.

Teachs and Teams could be suitably instantiated in code handling Initialize event of BatchClass class.

Private Sub Class_Initialize()
    Set Techs = New clsTechV2
    Set Teams = New clsTeamV2
End Sub

Regards,
Fish

[PianoMan64]

Thanks for the reply FishVal,

Joe P.

[FishVal]

You are welcome Joe.

BTW, IMHO it is not a case to use events. Raising error would be more suitable. See example below.

Class module: clsChild

Public Function Foo(intInput As Long) As Long
    
    Select Case intInput
        Case 0
            Foo = 0
        Case 1
            Err.Raise Number:=10000, Source:="clsChild.Foo", Description:="Value could not be 1"
        Case 2
            Err.Raise Number:=10001, Source:="clsChild.Foo", Description:="Value could not be 2"
        Case 3
            Err.Raise Number:=10002, Source:="clsChild.Foo", Description:="Value could not be 3"
        Case 4
            Err.Raise Number:=10003, Source:="clsChild.Foo", Description:="Value could not be 4"
        Case Else
            Err.Raise Number:=10100, Source:="clsChild.Foo", Description:="Unspecified error"
    End Select
    
End Function

Class module: clsParent

Private objChild As New clsChild

Public Sub Foo()
    
    Dim i As Long
    
    On Error GoTo ErrHandler
    
    For i = 0 To 10
        Debug.Print objChild.Foo(i)
    Next i
    
    Exit Sub
    
ErrHandler:
    Debug.Print Err.Number, Err.Source, Err.Description
    Resume Next
    
End Sub