VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Company"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'***********************************************************
'Code generated by Visible Developer(tm).
'Date: 1/29/2002 9:54:45 AM
'Version Number 2.6.1a
'Copyright Visible Systems 1998 - 2001  All Rights Reserved
'***********************************************************

'*************************************************
'Layer 2: - Company Business Object
'*************************************************
'
'Company is based on the Company table.
'Standard business operations supported by this business object:
'   Add         Creates a new Company
'   Delete      Permanently removes a Company from the database
'   Read        Loads values of a Company from the database
'   Update      Makes changes to a Company
'
Option Explicit
Option Base 1

'Property values are stored in a disconnected recordset or XML document.
'Disconnected Recordsets: mrsCompany is a disconnected ADOR recordset
'returned from the persistence layer.
Private mrsCompany As ADOR.Recordset

'Reference to the persistence class that performs all database actions.
Private myCompanyPersist As CompanyPersist

'Reference to message queue object is passed to StartUp method during initialization.
'myBusObjState also holds a reference to the message queue.
Private myMessageQueue As mtrMessageQueue

'UserObject is an optional parameter passed to the StartUp method.
'Examples of POSSIBLE UserObject Properties are: User Name, Password, Computer Name, etc.
Private myUserObject As Object

'Name of the top-level business object.
Private Const cstBusinessObjectName As String = "Company"

'Name of this class.
Private Const cstClassName As String = "Company"

'Names of Properties are defined as constants.  Property names are a
'parameter passed to myBusObjState to set/get property restrictions.
Const cstBusinessCode = "BusinessCode"
Const cstCategory = "Category"
Const cstCredit_Rating = "Credit_Rating"
Const cstMemo = "Memo"
Const cstName = "Name"
Const cstNumber = "Number"
Const cstStateOfIncorporationCode = "StateOfIncorporationCode"
Const cstStatus = "Status"
Const cstTax_Exempt = "Tax_Exempt"
Const cstParentCompany = "ParentCompany"
Const cstCompanyType = "CompanyType"

'Reference to the CompanyRule class.  It is a private class that
'contains the logic for each business rule.
Private myRules As CompanyRules

'The following variables are never assigned values so they remain
'as initialized by Visual Basic.  Properties that are not mandatory are
'assigned these values if valid values are not provided.  If the user is
'restricted from viewing a property, the corresponding "Default" property value is returned to the UI.
Private mintDefaultNumeric As Integer      'Used for all numeric data types
Private mdtmDefaultDate As Date
Private mstrDefaultString As String
Private mblnDefaultBoolean As Boolean

'mstrUserID stores the logon id of the user currently using the Employee object
Private mstrUserID As String

'EVENTS AVAILABLE TO THE USER INTERFACE
'An event is raised when a change in the state of one or more business rules
'causes a method to change from executable to non-executable or vice versa.
'The UI can subscribe to this event and then use the XXXIsValid functions to determine if operations
'exposed by the UI are now valid.
Event BusinessRuleChange()

'An event is raised whenever the business object changes the value of a property other
'than when a value changes due to a Property Let.  For example, if a "Property Let A" sub
'also changes the value of property B, the UpdatePropertyValues event is raised so the UI
'is alerted to the change and can update its controls.
Event UpdatePropertyValues()

Event PermittedValuesChanged()

'The PropertyRestrictionChanged event is raised each time a viewing or
'editing restriction changes.  Viewing and editing restrictions are maintained
'internally in the myBusObjState object.
Event PropertyRestrictionChanged()

'Reference to a mtrBusObjState object that contains state information for Company
'Object is created by Company and passed to each contained object.
Private myBusObjState As mtrBusObjState

'The MessagesCreated event is raised when a message object is created and the
'severity of the message is below the threshold for reporting errors (which is done by raising a VB error)
'and above the threshold for reporting messages.
'Event is raised if message severity is >= MessageThreshold property
Event MessagesCreated()

'|||Add additional variable declarations here
'<<<Start Edit Point:  Declarations
'Insert additional declarations here
'>>>End Edit Point:  Declarations
'**************************************************************
'****************  BUSINESS OBJECT PROPERTIES   ***************
'**************************************************************

Property Get BusinessCode() As String
    On Error GoTo HandleError

    BusinessCode = GetPropertyValue(cstBusinessCode, True)

    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Property Get BusinessCode"
End Property
Property Get Category() As String
    On Error GoTo HandleError

    Category = GetPropertyValue(cstCategory, True)

    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Property Get Category"
End Property
Property Get Credit_Rating() As String
    On Error GoTo HandleError

    Credit_Rating = GetPropertyValue(cstCredit_Rating, True)

    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Property Get Credit_Rating"
End Property
Property Get Memo() As String
    On Error GoTo HandleError

    Memo = GetPropertyValue(cstMemo, True)

    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Property Get Memo"
End Property
Property Get Name() As String
    On Error GoTo HandleError

    Name = GetPropertyValue(cstName, True)

    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Property Get Name"
End Property
Property Get Number() As String
    On Error GoTo HandleError

    Number = GetPropertyValue(cstNumber, True)

    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Property Get Number"
End Property
Property Get StateOfIncorporationCode() As String
    On Error GoTo HandleError

    StateOfIncorporationCode = GetPropertyValue(cstStateOfIncorporationCode, True)

    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Property Get StateOfIncorporationCode"
End Property
Property Get Status() As String
    On Error GoTo HandleError

    Status = GetPropertyValue(cstStatus, True)

    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Property Get Status"
End Property
Property Get Tax_Exempt() As String
    On Error GoTo HandleError

    Tax_Exempt = GetPropertyValue(cstTax_Exempt, True)

    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Property Get Tax_Exempt"
End Property
Property Get ParentCompany() As String
    On Error GoTo HandleError

    ParentCompany = GetPropertyValue(cstParentCompany, True)

    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Property Get ParentCompany"
End Property
Property Get CompanyType() As String
    On Error GoTo HandleError

    CompanyType = GetPropertyValue(cstCompanyType, True)

    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Property Get CompanyType"
End Property
Public Property Get MessageQueue() As mtrMessageQueue
    Set MessageQueue = myMessageQueue
End Property
Public Property Set MessageQueue(ByRef objMessageQueue As mtrMessageQueue)
    Set myMessageQueue = objMessageQueue
End Property
Friend Property Get UserObject() As Object
'Exposed primarily for use by business rules.
    Set UserObject = myUserObject
End Property
Public Function IsDeleted() As Boolean
    IsDeleted = myBusObjState.IsDeleted
End Function
Public Function IsNew() As Boolean
    IsNew = myBusObjState.IsNew
End Function
Public Function IsChanged() As Boolean
    IsChanged = myBusObjState.IsChanged
End Function
Public Function IsEditing() As Boolean
    IsEditing = myBusObjState.IsEditing(cstClassName)
End Function
Public Property Get MessageThreshold() As Long
    MessageThreshold = myBusObjState.MessageThreshold
End Property
Public Property Get ErrorThreshold() As Long
    ErrorThreshold = myBusObjState.ErrorThreshold
End Property
Public Property Get ReportErrors() As Boolean
    ReportErrors = myBusObjState.ReportErrors
End Property
Public Property Get ReportMessages() As Boolean
    ReportMessages = myBusObjState.ReportMessages
End Property
Public Function MethodIsExecutable(ByVal strMethodName As String) As Boolean
   On Error GoTo HandleError
   MethodIsExecutable = myBusObjState.MethodIsExecutable(strMethodName)

   Exit Function

HandleError:
        ExitBusinessObject False, "Company.MethodIsExecutable"
End Function
Public Function PropertyIsViewable(ByVal strPropName As String) As Boolean
   On Error GoTo HandleError
   PropertyIsViewable = myBusObjState.PropertyIsViewable(strPropName)

   Exit Function

HandleError:
        ExitBusinessObject False, "Company.PropertyIsViewable"
End Function
Public Function PropertyIsEditable(ByVal strPropName As String) As Boolean
   On Error GoTo HandleError
   PropertyIsEditable = myBusObjState.PropertyIsEditable(strPropName)

   Exit Function

HandleError:
        ExitBusinessObject False, "Company.PropertyIsEditable"
End Function
Public Function Classes() As Collection
   On Error GoTo HandleError
   Set Classes = myBusObjState.Classes()

   Exit Function

HandleError:
        ExitBusinessObject False, "Company.Classes"
End Function
Public Function ObjectName() As String
   On Error GoTo HandleError
   ObjectName = cstBusinessObjectName

   Exit Function

HandleError:
        ExitBusinessObject False, "Company.ObjectName"
End Function
Public Function Properties(Optional ByVal strClassName As Variant) As Collection
   On Error GoTo HandleError
   Set Properties = myBusObjState.Properties(strClassName)

   Exit Function

HandleError:
        ExitBusinessObject False, "Company.Properties"
End Function
Public Function Rules() As Collection
   On Error GoTo HandleError
   Set Rules = myBusObjState.Rules()

   Exit Function

HandleError:
        ExitBusinessObject False, "Company.Rules"
End Function
Public Function Methods() As Collection
   On Error GoTo HandleError
   Set Methods = myBusObjState.Methods()

   Exit Function

HandleError:
        ExitBusinessObject False, "Company.Methods"
End Function
Public Function GetPropertyAttribute(ByVal strPropertyName As String, ByVal lngAttributeType As mtr_PropertyAttributes_enum) As Variant
   On Error GoTo HandleError
   GetPropertyAttribute = myBusObjState.GetPropertyAttribute(strPropertyName, lngAttributeType)

   Exit Function

HandleError:
        ExitBusinessObject False, "Company.GetPropertyAttribute"
End Function
Public Function GetMethodAttribute(ByVal strMethodName As String, ByVal lngAttributeType As mtr_MethodAttributes_enum) As Variant
   On Error GoTo HandleError
   GetMethodAttribute = myBusObjState.GetMethodAttribute(strMethodName, lngAttributeType)

   Exit Function

HandleError:
        ExitBusinessObject False, "Company.GetMethodAttribute"
End Function
Property Get ObjectID() As String
'Creates a string containing XML elements that define the
'properties and corresponding property values that determine a unique Company.
'The XML elements in an ObjectID are a subset of the elements used in a Business Object View.
'Criteria:  Contains the Property, Operation, and Value elements.
'Property is the name of the Property.  It corresponds to a key field.
'Operation is always "=" for an ObjectID
'Value is a string representation of the corresponding Property value.

Dim strXML As String
    On Error GoTo HandleError

    strXML = strXML & "<View>"
    strXML = strXML & "<Criteria>"
    strXML = strXML & "<Property>Number</Property>"
    strXML = strXML & "<Operation>=</Operation>"
    strXML = strXML & "<Value>" & CStr(mrsCompany.Fields("Number")) & "</Value>"
    strXML = strXML & "</Criteria>"

    strXML = strXML & "</View>"

    ObjectID = strXML

    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.ObjectID"
End Property
Public Function GetXML(ByRef objView As Variant) As String

    GetXML = myBusObjState.GetDetailXML(mrsCompany, cstBusinessObjectName, objView, False)

End Function
Property Let BusinessCode(ByVal strValue As String)
    On Error GoTo HandleError
    myBusObjState.EntryPoint cstBusinessCode, mtr_pt_PropertyLet

    strValue = RTrim(strValue)
    SetPropertyValue cstBusinessCode, strValue

    On Error GoTo 0
    ExitBusinessObject True, cstBusinessCode, mtr_pt_PropertyLet
    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.BusinessCode_PropertyLet"
End Property
Property Let Category(ByVal strValue As String)
    On Error GoTo HandleError
    myBusObjState.EntryPoint cstCategory, mtr_pt_PropertyLet

    strValue = RTrim(strValue)
    SetPropertyValue cstCategory, strValue

    On Error GoTo 0
    ExitBusinessObject True, cstCategory, mtr_pt_PropertyLet
    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Category_PropertyLet"
End Property
Property Let Credit_Rating(ByVal strValue As String)
    On Error GoTo HandleError
    myBusObjState.EntryPoint cstCredit_Rating, mtr_pt_PropertyLet

    strValue = RTrim(strValue)
    SetPropertyValue cstCredit_Rating, strValue

    On Error GoTo 0
    ExitBusinessObject True, cstCredit_Rating, mtr_pt_PropertyLet
    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Credit_Rating_PropertyLet"
End Property
Property Let Memo(ByVal strValue As String)
    On Error GoTo HandleError
    myBusObjState.EntryPoint cstMemo, mtr_pt_PropertyLet

    strValue = RTrim(strValue)
    SetPropertyValue cstMemo, strValue

    On Error GoTo 0
    ExitBusinessObject True, cstMemo, mtr_pt_PropertyLet
    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Memo_PropertyLet"
End Property
Property Let Name(ByVal strValue As String)
    On Error GoTo HandleError
    myBusObjState.EntryPoint cstName, mtr_pt_PropertyLet

    strValue = RTrim(strValue)
    SetPropertyValue cstName, strValue

    On Error GoTo 0
    ExitBusinessObject True, cstName, mtr_pt_PropertyLet
    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Name_PropertyLet"
End Property
Property Let Number(ByVal strValue As String)
    On Error GoTo HandleError
    myBusObjState.EntryPoint cstNumber, mtr_pt_PropertyLet

    strValue = RTrim(strValue)
    SetPropertyValue cstNumber, strValue

    On Error GoTo 0
    ExitBusinessObject True, cstNumber, mtr_pt_PropertyLet
    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Number_PropertyLet"
End Property
Property Let StateOfIncorporationCode(ByVal strValue As String)
    On Error GoTo HandleError
    myBusObjState.EntryPoint cstStateOfIncorporationCode, mtr_pt_PropertyLet

    strValue = RTrim(strValue)
    SetPropertyValue cstStateOfIncorporationCode, strValue

    On Error GoTo 0
    ExitBusinessObject True, cstStateOfIncorporationCode, mtr_pt_PropertyLet
    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.StateOfIncorporationCode_PropertyLet"
End Property
Property Let Status(ByVal strValue As String)
    On Error GoTo HandleError
    myBusObjState.EntryPoint cstStatus, mtr_pt_PropertyLet

    strValue = RTrim(strValue)
    SetPropertyValue cstStatus, strValue

    On Error GoTo 0
    ExitBusinessObject True, cstStatus, mtr_pt_PropertyLet
    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Status_PropertyLet"
End Property
Property Let Tax_Exempt(ByVal strValue As String)
    On Error GoTo HandleError
    myBusObjState.EntryPoint cstTax_Exempt, mtr_pt_PropertyLet

    strValue = RTrim(strValue)
    SetPropertyValue cstTax_Exempt, strValue

    On Error GoTo 0
    ExitBusinessObject True, cstTax_Exempt, mtr_pt_PropertyLet
    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Tax_Exempt_PropertyLet"
End Property
Property Let ParentCompany(ByVal strValue As String)
    On Error GoTo HandleError
    myBusObjState.EntryPoint cstParentCompany, mtr_pt_PropertyLet

    strValue = RTrim(strValue)
    SetPropertyValue cstParentCompany, strValue

    On Error GoTo 0
    ExitBusinessObject True, cstParentCompany, mtr_pt_PropertyLet
    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.ParentCompany_PropertyLet"
End Property
Property Let CompanyType(ByVal strValue As String)
    On Error GoTo HandleError
    myBusObjState.EntryPoint cstCompanyType, mtr_pt_PropertyLet

    strValue = RTrim(strValue)
    SetPropertyValue cstCompanyType, strValue

    On Error GoTo 0
    ExitBusinessObject True, cstCompanyType, mtr_pt_PropertyLet
    Exit Property

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.CompanyType_PropertyLet"
End Property
Public Sub LetXML(ByVal strXML As String)
   Set mrsCompany = gobjMtrCommon.GetProperties_From_XML(cstBusinessObjectName, strXML)
   myBusObjState.MethodIsExecutable("Add") = True
End Sub
Public Property Let ErrorThreshold(ByVal lngMinSeverity As mtr_BusRuleSeverity_enum)
    myBusObjState.ErrorThreshold = lngMinSeverity
End Property
Public Property Let MessageThreshold(ByVal lngMinSeverity As mtr_BusRuleSeverity_enum)
    myBusObjState.MessageThreshold = lngMinSeverity
End Property
Public Property Let ReportErrors(ByVal blnValue As Boolean)
    myBusObjState.ReportErrors = blnValue
End Property
Public Property Let ReportMessages(ByVal blnValue As Boolean)
    myBusObjState.ReportMessages = blnValue
End Property
Public Sub Add()
Dim strUpdatedProperties As String

'Create a new Company in the database using the current property values
    On Error GoTo HandleError
    myBusObjState.EntryPoint "Add", mtr_pt_Method

    'All editing session must be ended before a database action.
    If myBusObjState.AllEditsSaved Then

        'Evaluate business rules scheduled to execute before
        'Add is executed.
        EvaluateRules mtr_br_BeforeMethodExecuted, "Add"

        If MethodIsExecutable("Add") Then

            'Invoke Add method of the persistence object passing the disconnected recordset
            'If persistence layer changes a property value (Autonumber or Identity field,
            'for example) the new value is returned.
            strUpdatedProperties = myCompanyPersist.Save("Add", mrsCompany)

            If strUpdatedProperties <> vbNullString Then
                'Use common procedure to update changed property values
                gobjMtrCommon.UpdatePropertyValues mrsCompany, strUpdatedProperties
            End If

            'Update the business object's state.
            myBusObjState.ObjectSaved

            'Evaluate business rules scheduled to execute after
            'Add is executed.
            EvaluateRules mtr_br_AfterMethodExecuted, "Add"

       Else

            'Not all rules required by the Add method are satisfied
            'Create a message and exit
            myBusObjState.CreateMessage mtr_se_MethodNotExecutable, _
                "A Company cannot be added because one or more required rules are not satisfied.", _
                "Company business object", _
                "Add", _
                mtr_pt_Method

       End If

    Else
        'Not all edit sessions are closed
        Err.Raise vbObjectError, cstBusinessObjectName, "A Company cannot be added because at least one editing session is open."
    End If

    On Error GoTo 0
    ExitBusinessObject True, "Add", mtr_pt_Method
    Exit Sub

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    'Next statement required to bypass ADO bug
    mrsCompany.MoveFirst
    ExitBusinessObject False, "Company.Add"
End Sub
Public Sub Delete()
'Remove the current Company from the database
    On Error GoTo HandleError
    myBusObjState.EntryPoint "Delete", mtr_pt_Method

    'Evaluate business rules scheduled to execute before
    'Add is executed.
    EvaluateRules mtr_br_BeforeMethodExecuted, "Delete"

    If MethodIsExecutable("Delete") Then

        'Invoke Update method of the persistence object
        myCompanyPersist.Delete mrsCompany

        'After this call to myBusObjState the Company has
        'the following default state values:
        '1) All properties are no longer editable
        '2) All methods are no longer executable.
        'To change these default values add a business rule and schedule
        'it to evaluate when the object is deleted.
        myBusObjState.ObjectDeleted

        'Evaluate business rules scheduled to execute after
        'Add is executed.
        EvaluateRules mtr_br_AfterMethodExecuted, "Delete"

       Else

            'Not all rules required by the Delete method are satisfied
            'Create a message and exit
            myBusObjState.CreateMessage mtr_se_MethodNotExecutable, _
                "A Company cannot be deleted because one or more required rules are not satisfied.", _
                "Company business object", _
                "Delete", _
                mtr_pt_Method

       End If

    On Error GoTo 0
    ExitBusinessObject True, "Delete", mtr_pt_Method
    Exit Sub

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Delete"

End Sub
Public Sub Read(ByVal strObjectID As String)
'Obtains Company from the database using the ObjectID.
'All current property values, if any are set, will be overwritten
    On Error GoTo HandleError
    myBusObjState.EntryPoint "Read", mtr_pt_Method

    'Evaluate business rules scheduled to execute before
    'Add is executed.
    EvaluateRules mtr_br_BeforeMethodExecuted, "Read"

    If MethodIsExecutable("Read") Then

        'Use the layer 3 persistence object to read a Company
        Set mrsCompany = myCompanyPersist.Read(strObjectID)

        'mrsCompany is a hierarchical recordset.  It contains a
        'child recordset for each private subclass of Company.
        'These private "contained" classes store their property values
        'in their own child recordset.
        DefineSubclassRecordsets

        'After this call to myBusObjState the Company has
        'the following default state values:
        '1) All properties are valid.
        '2) All properties are editable except primary keys
        '3) All properties except system generated are viewable.
        '4) Read is not executable.
        'To change these default values add a business rule and schedule
        'it to evaluate after the business ojbect is read.
         myBusObjState.ObjectRead

        'Evaluate business rules scheduled to execute after
        'Add is executed.
        EvaluateRules mtr_br_AfterMethodExecuted, "Read"

    Else

        'Not all rules required by the Read method are satisfied
        'Create a message and exit
        myBusObjState.CreateMessage mtr_se_MethodNotExecutable, _
            "A Company cannot be read because one or more required rules are not satisfied.", _
            "Company business object", _
            "Read", _
            mtr_pt_Method

    End If

    On Error GoTo 0
    ExitBusinessObject True, "Read", mtr_pt_Method
    Exit Sub

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Read"
End Sub
Public Sub Update()
'Modifies the database using the current Company property values
    On Error GoTo HandleError
    myBusObjState.EntryPoint "UpDate", mtr_pt_Method

    'Exit before creating a persistence object if property values are unchanged
    If Not myBusObjState.IsChanged Then
        Exit Sub
    End If

    'All editing session must be ended before a database action.
    If myBusObjState.AllEditsSaved Then

       'Evaluate business rules scheduled to execute before
       'Add is executed.
       EvaluateRules mtr_br_BeforeMethodExecuted, "Update"

       If MethodIsExecutable("Update") Then

           'Invoke Update method of the persistence object
           myCompanyPersist.Save "Update", mrsCompany

           myBusObjState.ObjectSaved

           'Evaluate business rules scheduled to execute after
           'Add is executed.
           EvaluateRules mtr_br_AfterMethodExecuted, "Update"

        Else

            'Not all rules required by the Update method are satisfied
            'Create a message and exit
            myBusObjState.CreateMessage mtr_se_MethodNotExecutable, _
                "A Company cannot be updated because one or more required rules are not satisfied.", _
                "Company business object", _
                "Update", _
                mtr_pt_Method

        End If

    Else
        'Not all edit session are closed
        Err.Raise vbObjectError, cstBusinessObjectName, "A Company cannot be added because at least one editing session is open."
    End If

    'Clean up

    On Error GoTo 0
    ExitBusinessObject True, "UpDate", mtr_pt_Method
    Exit Sub

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.Update"
End Sub
Public Function GetPermittedValues(ByVal strPropertyName As String) As Collection
'Function used by the UI to retrieve a collection containing the permitted values of
'the property identified by the strPropertyName parameter.
'Each item in the collection is a string.  If no permitted values exist an empty collection is returned.

    'Rules can update property permitted values
    EvaluateRules mtr_br_GetPermittedValues, strPropertyName

    Set GetPermittedValues = myBusObjState.GetPermittedValues(strPropertyName)

    Exit Function

'**************** Error Handler *****************
HandleError:

    'Call error handling routine
    ExitBusinessObject False, "Company.GetPermittedValues"
End Function
Public Sub StartEdit()

    On Error GoTo HandleError

    'Begin editing properties in this class.
    '1) Property Lets are allowed
    '2) Business operations (add, update, delete, etc.) are allowed
    myBusObjState.IsEditing(cstClassName) = True

    Exit Sub

'**************** Error Handler *****************
HandleError:

    'Call error handling routine
    ExitBusinessObject False, "Company.StartEdit"
End Sub
Public Sub CancelEdit()
'Stop editing process and restore properties to the values
'they had when this editing session began.
Dim objField As ADOR.Field
    On Error GoTo HandleError

    myBusObjState.IsEditing(cstClassName) = False


    Set objField = Nothing
    Exit Sub

'**************** Error Handler *****************
HandleError:
   'Destroy objects

    'Call error handling routine
    ExitBusinessObject False, "Company.CancelEdit"
End Sub
Public Sub SaveEdits()
'Stop editing process and keep changes made
'during this editing session began.
    On Error GoTo HandleError

    If myBusObjState.IsEditing(cstClassName) Then


        myBusObjState.IsEditing(cstClassName) = False
    Else
        Err.Raise vbObjectError + 1, cstClassName, "Not editing"
    End If

    On Error GoTo 0
    ExitBusinessObject True, "SaveEdits", mtr_pt_Method
    Exit Sub

'**************** Error Handler *****************
HandleError:

    'Call error handling routine
    ExitBusinessObject False, "Company.SaveEdits"
End Sub
Public Function GetRulesByMethod(ByVal strMethodName As String) As Collection
    Set GetRulesByMethod = myBusObjState.GetRulesByMethod(strMethodName)
End Function
Public Function GetRulesByEvent(ByVal lngEventType As mtr_BusRuleEvent_enum, ByVal strEventName As String) As Collection
    Set GetRulesByEvent = myBusObjState.GetRulesByEvent(lngEventType, strEventName)
End Function
Public Function GetRuleByName(ByVal strRuleName As String) As Object
    Set GetRuleByName = myBusObjState.GetRuleByName(strRuleName)
 End Function
Public Function GetView(ByVal strViewName As String) As mtrBusObjView

    On Error GoTo HandleError

   'View object creation centrally located in the Rules class.
    Set GetView = myRules.GetView(strViewName)

    Exit Function

HandleError:
    ExitBusinessObject False, "Company.GetView"
End Function
Public Function GetPermittedRanges(ByVal strPropertyName As String) As Collection
'Function used by the UI to retrieve a collection containing the permitted ranges of
'the property identified by the strPropertyName parameter.
'Each item in the collection is a mtrPVRange object.  If no permitted ranges exist an empty collection is returned.

    Set GetPermittedRanges = myBusObjState.GetPermittedRanges(strPropertyName)

    Exit Function

'**************** Error Handler *****************
HandleError:

    'Call error handling routine
    ExitBusinessObject False, "Company.GetPermittedRanges"
End Function
Public Sub ShutDown()
    'Shutdown procedure is used to remove all shared references between classes
    'If it was not called the reference count would not be set to zero and
    'objects would remain in memory.

    On Error GoTo HandleError


    myBusObjState.ShutDown

'|||Insert additional shutdown logic here
'<<<Start Edit Point:  Class Shutdown
'Insert logic performed at business object shutdown here
'>>>End Edit Point:

    Set myRules = Nothing
    Set myBusObjState = Nothing
    Exit Sub

'**************** Error Handler *****************
HandleError:
    'Call error handling routine
    ExitBusinessObject False, "Company.ShutDown"
End Sub
Public Sub StartUp(ByRef varMessageQueue As Variant, _
                    Optional ByRef varUserObject As Object)

'StartUp is called immediately after a new object is initialized.
'UI must always pass a reference to a MessageQueue.  Business object
'places all messages in the queue.
'
'UserObject is an optional reference.  It is provided as a means for the
'UI to pass general information to business objects.
'Examples are: User Name, Password, Computer Name, etc.
'Business rules can use properties of the UserObject.

Dim strXML As String

    On Error GoTo HandleError

    'MessageQueue passed as a variant because some UIs
    '(ASP for example) only work with variants
    Set myMessageQueue = varMessageQueue

   'UI optionally passes UserObject reference
   'Properties and methods of UserObject defined by developer.
   'Common examples are: user name, user role, user privileges, etc.
    Set myUserObject = varUserObject

    'Check for valid MessageQueue object and raise error if UI neglected to provide one
    If myMessageQueue Is Nothing Then
        Err.Raise vbObjectError, "StartUp", "MessageQueue object reference was not passed to StartUp method."
    End If

    'Reference to the persistence class is obtained if one does not already exist.
    If myCompanyPersist Is Nothing Then
        Set myCompanyPersist = New CompanyPersist
    End If

    'MtrCommon object (gobjMtrCommon) from mtrBusObjRT component is passed the name
    'of the business object.  One instance of gobjMtrCommon is created by
    'Sub Main in the component containing the Company class.  gobjMtrCommon
    'provides services for all business objects in the component but the business objects
    'must register before making a request.
    If gobjMtrCommon.IsRegistered(cstBusinessObjectName) Then
        'A previous instance of Company registered itself with mtrCommon and provided
        'objects that are shared among all instances.

    Else

        'First instance of Company created since the component was loaded.
        'Several tasks are performed once and the result is stored with gobjMtrCommon
        'so future instances of the Company object will not need to perform these tasks.

        '1) Obtain XML definition of Company business object and pass to
        'gobjMtrCommon for later use by this and future instances of Company.
        strXML = myCompanyPersist.GetBusObjXML
        gobjMtrCommon.Register cstBusinessObjectName, strXML

        '2) Now obtain recordset of permitted values and pass to gobjMtrCommon
        gobjMtrCommon.PermittedValues(cstBusinessObjectName) = myCompanyPersist.GetPermittedValues

        '3) Use persistence method to create the Shape command used to create an
        'empty hierarchical recordset structure and store it with gobjMtrCommon.
        'The manufactured recordset is used when a new Company is created.
        gobjMtrCommon.RecordsetSQL(cstBusinessObjectName) = myCompanyPersist.GetEmptyRecordset()

    End If

     'Obtain a manufactured recordset to hold property values
     Set mrsCompany = gobjMtrCommon.Recordset(cstBusinessObjectName)
     mrsCompany.AddNew

    'Obtain the helper object that maintains state information
    Set myBusObjState = gobjMtrCommon.GetBusObjState(cstBusinessObjectName)

    'Create an instance of CompanyRules.  It is a private helper class.
    'For each rule, Company has a Public function with the same name
    'that is the buisness logic for the rule.
    Set myRules = New CompanyRules
    Set myRules.Company = Me
    Set myRules.BusObjState = myBusObjState
    Set myBusObjState.BusinessRules = myRules
    Set myBusObjState.MessageQueue = myMessageQueue
    myBusObjState.EntryPoint "StartUp", mtr_pt_Method


    'mrsCompany is a hierarchical recordset.
    'Call subs to define the child recordsets.
    DefineSubclassRecordsets

   'After this call to myBusObjState the Company has
   'the following default state values:
   '1) All mandatory properties are not valid.  Optional properties are valid.
   '2) All properties are editable
   '3) All except system generated properties are viewable.
   '4) Read is the only executable method.
   'To change these default values add a business rule and schedule
   'it to evaluate when the class is initialized.
    myBusObjState.ObjectInitialized

    'Start an editing session
    myBusObjState.IsEditing(cstClassName) = True

    EvaluateRules mtr_br_ClassInitialize, cstClassName

'|||Insert additional class initialization statement here
'<<<Start Edit Point:  Class StartUp
'Insert logic performed at business object startup here
'>>>End Edit Point:

    'Cleanup after error
    On Error GoTo 0
    ExitBusinessObject True, "StartUp", mtr_pt_Method
    Exit Sub

'**************** Error Handler *****************
HandleError:
   'Destroy objects

    'Call error handling routine
    ExitBusinessObject False, "Company.StartUp"
End Sub
Public Function GetPropertyValue(ByVal strPropertyName As String, Optional ByVal blnTranslate As Boolean) As String
Dim rsProperties As ADOR.Recordset
'strPropertyName:      Full name of Company property
'blnTranslate:         Optional boolean.  If True or missing, the value returned is
'                      a displayed value.  If False it is the stored value.
'                      Note:  Unless the property has permitted values, the displayed and
'                      stored values are the same.

    On Error GoTo HandleError

'   Check restrictions before providing the property value
    If myBusObjState.PropertyIsViewable(strPropertyName) Then

        'Property is stored in the top level recordset or one of the
        'child recordsets that correspond to a Table included using a Many-to-1 relationship.
        'The property value is taken from a recordset field with the same name

        Set rsProperties = GetPropertyRS(strPropertyName)

        If rsProperties Is Nothing Then
            'The recordset is a grandchild recordset
            'and it does not exist yet.
            GetPropertyValue = vbNullString
        ElseIf rsProperties.RecordCount = 0 Then
            'The recordset is a child related to a parent
            'but foreign key that links the parent and child
            'is not entered yet.
            GetPropertyValue = vbNullString
        ElseIf IsNull(rsProperties.Fields(strPropertyName)) Then
           GetPropertyValue = vbNullString
        Else

            GetPropertyValue = rsProperties.Fields(strPropertyName)

            'Translate from stored to displayed (when applicable) if
            'blnTranslate parameter is True or if not supplied
            If IsMissing(blnTranslate) Then blnTranslate = True

            If blnTranslate Then

                'If the Property has permitted values, then the value in rsProperties is the "stored value"
                'and the equivalent "displayed value" is returned in a Property Get.
                If myBusObjState.GetPropertyAttribute(strPropertyName, mtr_pa_PermittedValues) _
                    And Not rsProperties.RecordCount = 0 Then
                    GetPropertyValue = myBusObjState.GetDisplayedValue(strPropertyName, rsProperties.Fields(strPropertyName))
                End If

            End If

        End If

        'Evaluate rules before value is returned to the UI
        myBusObjState.EvaluateRules mtr_br_BeforePropertyValueReturned, strPropertyName

    Else
        'Property is not viewable.  Return empty string and raise an error
        'The error number, mtr_se_PropertyNotViewable, and error source, myBusObjState.StdError
        'identify this as a standard error and not an unexpected system error.
        GetPropertyValue = ""
        Err.Raise mtr_se_PropertyNotViewable, myBusObjState.StdError(), strPropertyName
    End If

    Exit Function

'**************** Error Handler *****************
HandleError:
    'Continue to raise error until a public procedure is reached.
    TraceError "GetPropertyValue"
End Function
Private Function GetPropertyRS(ByVal strPropertyName As String) As ADOR.Recordset

    On Error GoTo HandleError

    'Company contains properties derived from a single table - Company.
    'Return a reference to the recordset passed back by the persistence layer.
    Set GetPropertyRS = mrsCompany


    'Cleanup
    Exit Function

'**************** Error Handler *****************
HandleError:
    'Continue to raise error until a public procedure is reached.
    TraceError "GetPropertyRS"
End Function
Private Sub DefineSubclassRecordsets()
    'Company does not contain any private subclasses.
    'Cleanup
    Exit Sub

'**************** Error Handler *****************
HandleError:
    'Continue to raise error until a public procedure is reached.
    TraceError "DefineSubclassRecordsets"
End Sub
Private Sub SetPropertyValue(ByVal strPropertyName As String, ByVal strValue As String)
Dim rsProperties As ADOR.Recordset
Dim strOldPropertyValue As String
Dim dteDefaultDate As Date

    On Error GoTo HandleError

    'No changes are permitted unless the class is editing
    'StartEdit must be called before property values are changed
    If myBusObjState.IsEditing(cstClassName) Then

        'If property is not editable skip all remaining steps.
        If myBusObjState.PropertyIsEditable(strPropertyName) Then

            'Store the current value of this property
            strOldPropertyValue = GetPropertyValue(strPropertyName)

            'Initialize state information for this property.  State information is used
            'by rules evaluated at the BeforePropertyValueChanged event.
            'Assume new property value is valid.  Rules will change
            'NewPropertyValueIsValid(strPropertyName) = False if validation fails.
            myBusObjState.NewPropertyValue(strPropertyName) = strValue
            myBusObjState.NewPropertyValueIsValid(strPropertyName) = True

            'Evaluate Rules before the new value is stored in the business object's
            'internal data structure.  These Rules:
            '1) Determine if the new value is valid using the myBusObjState.NewValueIsValid property
            '2) Can optionally change the new property value using the myBusObjState.NewPropertyValue property
            EvaluateRules mtr_br_BeforePropertyValueChanged, strPropertyName

            'Continue only if the new property value passed all the Rules
            If myBusObjState.NewPropertyValueIsValid(strPropertyName) Then

                'Rules could change the new property value so obtain the current value
                'from myBusObjState
                strValue = myBusObjState.NewPropertyValue(strPropertyName)

                'Take final steps only if value is changed
                If strValue <> strOldPropertyValue Then
                    'IsChanged property get/let tracks changes to Company.
                    'It is True if a property value in any property collection has changed since the last save.
                    myBusObjState.IsChanged = True
                    Set rsProperties = GetPropertyRS(strPropertyName)
                    If rsProperties.RecordCount = 0 Then rsProperties.AddNew

                    If strValue = vbNullString Then

                        If myBusObjState.GetPropertyAttribute(strPropertyName, mtr_pa_IsNullable) Then

                            'Property is nullable - supply a null value
                            rsProperties.Fields(strPropertyName) = Null

                        Else

                            'Property is not nullable
                            'Interpretation depends on data type and potentially the property

                            Select Case myBusObjState.GetPropertyAttribute(strPropertyName, mtr_pa_DataType)

                                Case "Date"
                                    rsProperties.Fields(strPropertyName) = dteDefaultDate

                                Case "Integer", "Long", "Single", "Double", "Currency"
                                    rsProperties.Fields(strPropertyName) = 0

                                Case "String"
                                    rsProperties.Fields(strPropertyName) = vbNullString

                                Case "Boolean"
                                    rsProperties.Fields(strPropertyName) = vbNullString

                            End Select

                        End If

                    Else

                        rsProperties.Fields(strPropertyName) = strValue

                    End If

                    'Changing a Property value is one of the standard events
                    'when rules are evaluated.  Pass the type of event and the
                    'name of the Property.
                    EvaluateRules mtr_br_PropertyValueChanged, strPropertyName

                End If

            Else
                'New property value not accepted.  Keep current value.
                'Rules create message objects and add them to the message queue
                'so no further steps required.

            End If

       Else
           'Property is not editable.
       End If

    Else
        'Editing session not started.
        Err.Raise vbObjectError + mtr_bs_Error, _
            cstBusinessObjectName, "StartEdit must be called before first property let"
    End If

    Exit Sub

'**************** Error Handler *****************
HandleError:
    'Continue to raise error until a public procedure is reached.
    TraceError "SetPropertyValue"
End Sub

Public Sub EvaluateRules(ByVal lngEventType As mtr_BusRuleEvent_enum, ByVal strEventName As String, _
                    Optional ByVal varArg1 As Variant, Optional ByVal varArg2 As Variant)
    'EvaluateRules method of myBusObjState will:
    '1) Execute all Rules scheduled for this event
    '2) Update related state information:  HighestSeverityLevel and Messages collection
    '3) Determine impact of changed Rule values on Company methods (if they are executable or not)
    '
    myBusObjState.EvaluateRules lngEventType, strEventName, varArg1, varArg2

End Sub
Friend Sub UpdateAfterFKChange(ByVal strFKPropertyName As String, rsNewValues As ADOR.Recordset)
'strFKPropertyName - full name of a Business Object Property
'rsNewValues - single row, contains values of Properties related to the foreign key.
'              The name of each field is the name of a Property.
'              If it is a child recordset, one field is used to link the child with the parent
'              and it is not a Property.

Dim objField As Field
Dim strClassName As String
Dim rsRelatedProps As Recordset

    'All properties returned in rsNewValues are stored in the same recordset
    'within the hierarchical recordset, mrsCompany.
    'Find the name of the class that contains the FK property
    'Each class updates properties dependent on FK properties it contains.
    strClassName = myBusObjState.GetPropertyAttribute(strFKPropertyName, mtr_pa_ClassName)

    Select Case strClassName

        Case cstClassName

            'FK property is in this class.
            'The names of the fields in rsNewValues correspond to property names
            'with the possible exception of the field used to link the recordset with the parent.
            'Use GetPropertyRS to find the recordset for the first field in rsNewValues
            'that corresponds to a Property
            For Each objField In rsNewValues.Fields
                If myBusObjState.ValidatePropertyName(objField.Name) Then
                    Set rsRelatedProps = GetPropertyRS(objField.Name)
                    Exit For
                End If
            Next objField

            rsRelatedProps.AddNew

            For Each objField In rsNewValues.Fields

                If rsRelatedProps.Fields(objField.Name).Properties("IsAutoIncrement") Then
                    'It is already set by AddNew and cannot be changed - skip it
                Else
                    rsRelatedProps.Fields(objField.Name) = objField.Value
                    If myBusObjState.ValidatePropertyName(objField.Name) Then
                        myBusObjState.PropertyIsValid(objField.Name) = True
                    End If
                End If

            Next objField
            rsRelatedProps.Update

            myBusObjState.PropertyValuesChanged = True

    End Select

    Set rsRelatedProps = Nothing
    Set objField = Nothing

End Sub
Public Sub ExitBusinessObject(ByVal blnNormalExit As Boolean, ByVal strProcedureName As String, Optional ByVal lngProcedureType As mtr_ProcedureType_Enum)
Dim objMessage As mtrMessage
Dim lngErrorNumber As Long
Dim strErrorDescription As String
Dim strErrorSource As String

    'Sub called as last step when a public procedure executes.
    'blnNormalExit:  True indicates VB error not raised during execution
    'strProcedureName:  Name of the previous procedure
    'strProcedureType:  Optional, mtr_ProcedureType_enum

    'Cannot assume myBusObjState exists.
    If myBusObjState Is Nothing Then
        If Err.Description = "" Then
            'At least let them know where the error happened
            Err.Raise vbObjectError, cstClassName, "Error during StartUp method."
        Else
            'Provide a meaningful error message
            Err.Raise vbObjectError, cstClassName, Err.Description
        End If
    End If

    'A mtrMessage object is created and added to the queue if this is not a normal exit.
    'VB error object always exists in this case.
    'This step is only required for abnormal exits because business rules create their own Message objects.
    If Not blnNormalExit Then
        myBusObjState.CreateMessage Err.Number, Err.Description, Err.Source, strProcedureName, lngProcedureType
    End If

    'It is possible to have nested calls to public procedures.
    'A business rule evaluated after a PropertyLet may call another Property Let
    If myBusObjState.IsFinalExitPoint Then

        If myBusObjState.MessageQueue.HighestSeverityLevel >= myBusObjState.ErrorThreshold And _
            myBusObjState.ReportErrors Then

            'Error reporting is turned on and messages meeting the criteria were created
            Err.Raise vbObjectError, cstClassName, "Errors found."

        ElseIf myBusObjState.MessageQueue.HighestSeverityLevel >= myBusObjState.MessageThreshold And _
                myBusObjState.MessageQueue.HighestSeverityLevel < myBusObjState.ErrorThreshold And _
                myBusObjState.ReportMessages Then

            'Message reporting is turned on and messages meeting the criteria were created
            RaiseEvent MessagesCreated

        End If

        'Rules can take any of these actions:
        '1) Change a Method from executable to non-executable or vice versa
        '   (MethodStateChanged = True)
        '2) Change one or more additional Property values
        '   (PropertyValuesChanged)
        '3) Change a Property restriction (examples: viewable to non-viewable, or editable to non-editable
        '   (PropertyRestrictionsCHanged = True)

        'The Business Object notifies the UI if any of the above situations occur
        'NOTE:  Before the Event is raised the corresponding state variable is set to False
        'to avoid a potential endless loop - UI could call Business Object in response to the
        'event and cause another event to be raised.

        If myBusObjState.MethodStateChanged Then
            myBusObjState.MethodStateChanged = False
            RaiseEvent BusinessRuleChange
        End If

        If myBusObjState.PropertyValuesChanged Then
            myBusObjState.PropertyValuesChanged = False
            RaiseEvent UpdatePropertyValues
        End If

        If myBusObjState.PropertyRestrictionsChanged Then
            myBusObjState.PropertyRestrictionsChanged = False
            RaiseEvent PropertyRestrictionChanged
        End If

        If myBusObjState.PermittedValuesChanged Then
            myBusObjState.PermittedValuesChanged = False
            RaiseEvent PermittedValuesChanged
        End If

        'Business object state resets information when exiting
        myBusObjState.ExitPoint blnNormalExit, strProcedureName, lngProcedureType

   Else
        'This is not the top-level exit point.  Continue raising errors if abnormal exit.
        If Not blnNormalExit Then Err.Raise lngErrorNumber, strErrorSource, strErrorDescription
   End If

End Sub
Friend Sub TraceError(ByVal strProcedureName As String)
Dim lngErrorNumber As Long
Dim strErrorSource As String
Dim strErrorDescription As String

    'Private procedures raise errors until a public procedure is reached.
    'Public procedures use ExitBusinessObject to process the error.

    lngErrorNumber = Err.Number
    strErrorDescription = Err.Description
    strErrorSource = strProcedureName & "-->" & Err.Source

    Err.Raise lngErrorNumber, strErrorSource, strErrorDescription

End Sub
Friend Sub PutPropertyValue(ByVal strPropertyName As String, ByVal varValue As Variant, Optional ByVal blnTranslate As Variant)
'strPropertyName:       Full name of a Company property
'varValue:              Value assigned to the property
'blnTranslate:          Optional boolean.  If True or missing, the value passed in the varValue parameter is
'                       translated from a displayed to a stored value.  If False it is
'                       assumed that varValue is a stored value.

'NOTE:  PutPropertyValue is a Friend sub used by the Rules class or other classes in the component
'It updates a property values but does NOT
'   Validate the data type or check for permitted values
'   Evaluate rules associated with the property
Dim rs As ADOR.Recordset

    On Error GoTo HandleError

    'First find the recordset used to store values of this property
    'It could be in the parent or one of the child recordsets
    Set rs = GetPropertyRS(strPropertyName)

    If rs Is Nothing Then
        'If no recordset is found either an invalid property name was provided
        'or else the property is in a child recordset and the child's parent
        'does not exist
        Err.Raise 1, "", "Cannot set value for property: " & strPropertyName

    Else

        If rs.RecordCount = 0 Then
            rs.AddNew
        End If

        'Translate from displayed to stored (when applicable) if
        'blnTranslate parameter is True or if not supplied
        If IsMissing(blnTranslate) Then blnTranslate = True

        If blnTranslate Then

            'Test to see if this property has permitted values
            If myBusObjState.GetPropertyAttribute(strPropertyName, mtr_pa_PermittedValues) Then
                'Translate to the Stored Value before inserting into the recordset
                varValue = myBusObjState.GetStoredValue(strPropertyName, varValue)
            End If

        End If

        rs.Fields(strPropertyName) = varValue
        myBusObjState.PropertyIsValid(strPropertyName) = True

    End If

    Exit Sub

 '**************** Error Handler *****************
HandleError:
    'Continue to raise error until a public procedure is reached.
    TraceError "PutPropertyValue"
End Sub
Private Sub Class_Initialize()

'|||Insert additional class initialization statements here
'<<<Start Edit Point:  Class Initialize
'Insert logic performed in class initialization here
'>>>End Edit Point:

    Exit Sub

'**************** Error Handler *****************
HandleError:
   'Destroy objects

    'Call error handling routine
    ExitBusinessObject False, "Company.Class_Initialize"
End Sub
Private Sub Class_Terminate()
    On Error GoTo HandleError

    'Destroy object references
    Set myBusObjState = Nothing
    Set mrsCompany = Nothing
    Set myRules = Nothing
    Set myMessageQueue = Nothing
    Set myCompanyPersist = Nothing
    Set myUserObject = Nothing

'|||  Add termination logic here
'<<<Start Edit Point: Class_Terminate
'Insert logic performed at class terminate here
'>>>End Edit Point:

Class_TerminateExit:
    'Cleanup after error
    Exit Sub

'**************** Error Handler *****************
HandleError:
   'Destroy objects

    'Call error handling routine
    ExitBusinessObject False, "Company.Class_Terminate"
End Sub
'|||  Add new subs and functions here
'<<<Start Edit Point: Additional Subs and Functions
'Insert additional functions and subs here
'>>>End Edit Point: