Visual Basic 6 Unleashed…sional Reference Edition)/Visual_Basic_6_Unleashed_Professional_Reference_Edition_Sams_1999.iso/Source/CHAP16/rsclsDataObjClass.cls

Visual Basic class definition | 1998-06-11 | 25.7 KB | 855 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 1  'vbDataSource
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "rsclsDataObjClass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "WizardYN" ,"Yes"
Attribute VB_Ext_KEY = "VBProjectName" ,"Project1"
Attribute VB_Ext_KEY = "DEDesignerName" ,"DataEnvironment1"
Attribute VB_Ext_KEY = "ConnectionName" ,"Connection1"
Attribute VB_Ext_KEY = "CommandName" ,"OrderInfo"
Attribute VB_Ext_KEY = "ClassRootName" ,"DataObjClass"
Attribute VB_Ext_KEY = "ClassType" ,"Data Class"
Attribute VB_Ext_KEY = "FKCommand1" ,"Customers"
Attribute VB_Ext_KEY = "FKCommand1_SELECTFIELDNAME1" ,"customerid"
Attribute VB_Ext_KEY = "FKCommand1_SELECTCOMMANDNAME1" ,"OrderInfo"
Attribute VB_Ext_KEY = "FKCommand1_FKFIELDNAME1" ,"customerid"
Attribute VB_Ext_KEY = "FKCommand1_FKCOMMANDNAME1" ,"Customers"
Attribute VB_Ext_KEY = "FKCommand1_FKDESCRIPTOR1" ,"CompanyName"
Attribute VB_Ext_KEY = "FKCommand1_FKNULLABLE1" ,"Yes"
Attribute VB_Ext_KEY = "FKCommand1_FKPKCount" ," 1"
Attribute VB_Ext_KEY = "SelectCommandName" ,"OrderInfo"
Attribute VB_Ext_KEY = "FieldNullableOrderID" ,"Yes"
Attribute VB_Ext_KEY = "FieldPKOrderID" ,"No"
Attribute VB_Ext_KEY = "FieldNullableCustomerID" ,"Yes"
Attribute VB_Ext_KEY = "FieldPKCustomerID" ,"No"
Attribute VB_Ext_KEY = "FieldNullableOrderDate" ,"Yes"
Attribute VB_Ext_KEY = "FieldPKOrderDate" ,"No"
Attribute VB_Ext_KEY = "FieldNullableProductID" ,"Yes"
Attribute VB_Ext_KEY = "FieldPKProductID" ,"No"
Attribute VB_Ext_KEY = "FieldNullableUnitPrice" ,"Yes"
Attribute VB_Ext_KEY = "FieldPKUnitPrice" ,"No"
Attribute VB_Ext_KEY = "FieldNullableQuantity" ,"Yes"
Attribute VB_Ext_KEY = "FieldPKQuantity" ,"No"
Attribute VB_Ext_KEY = "NumFKCommands" ,"1"
Attribute VB_Ext_KEY = "NumInterfaces" ,"1"
Attribute VB_Ext_KEY = "UseSelectCommand" ,"False"
'=============================================================
'Name: rsclsDataObjClass (a RecordSet class)
'
'Author: Microsoft Data Object Wizard
'
'Date: 06/11/1998 18:39
'
'Description: Contains RecordSet class used as a DataSource class
    'for a UserControl object.
'
'Comment: A new RecordSet class is created from the main 'Select' RecordSet class.
    'This RecordSet class is not connected to the database to allow for
    '(1) separate stored procedures for updates, inserts and deletes
     'and (2) control of update timing.
'=============================================================

Public SaveMode As EnumSaveMode 'Specifies either the Immediate or Batch mode Save property for the ResultSet class.

'The Data Environment object contains all the data access commands.
Private de1 As New DataEnvironment1

'Create a new RecordSet class to hold the Foreign Key attributes,
'    unless there are no Foreign Key attributes, then the Data Environment RecordSet class will be used.
Private WithEvents rs As Recordset
Attribute rs.VB_VarHelpID = -1

'Variant to store system generated Primary Key values.
Private vPKValues() As Variant

'Set the flag when record sets have been initialized.
Private mbDataInitialized As Boolean
'Flag to prohibit running the WillChangeRecord event.
Private mbAddingRecord As Boolean
'Flag to prohibit running the WillChangeRecord event when RecordSet class moves after the Delete method runs.
Private mbDeleteInProgress As Boolean

Private bInitComplete As Boolean 'Boolean flag is set when GetDataMember event is complete.
'This event is run when the RecordSet Move method is complete.
Public Event rsMoveComplete()
'This event is run when the RecordSet Delete method is complete.
Public Event DeleteRecordComplete()
'This event is run when the rsUpdate method is complete.
Public Event rsUpdateEvent(vFieldName As Variant)
'This event is run for certain class errors.
Public Event ClassError(sProcedureName As String, oErr As ErrObject)

' rsclsDataObjClass Foreign Key RecordSet classes
Public rsCustomers As ADODB.Recordset

'Foreign Key Parameter properties for the RecordSet classes.

'The external interface Get and Let properties.
Public Property Get OrderID() As Variant
    OrderID = rs("OrderID")
End Property
Public Property Let OrderID(vOrderID As Variant)
    If IsNull(vOrderID) Then
        rs("OrderID") = Null
    Else
        rs("OrderID") = CLng(vOrderID)
    End If
End Property

Public Property Get customerid() As Variant
    customerid = rs("CustomerID")
End Property
Public Property Let customerid(vCustomerID As Variant)
    If IsNull(vCustomerID) Then
        rs("CustomerID") = Null
    Else
        rs("CustomerID") = CStr(vCustomerID)
    End If
End Property

Public Property Get OrderDate() As Variant
    OrderDate = rs("OrderDate")
End Property
Public Property Let OrderDate(vOrderDate As Variant)
    If IsNull(vOrderDate) Then
        rs("OrderDate") = Null
    Else
        rs("OrderDate") = CDate(vOrderDate)
    End If
End Property

Public Property Get ProductID() As Variant
    ProductID = rs("ProductID")
End Property
Public Property Let ProductID(vProductID As Variant)
    If IsNull(vProductID) Then
        rs("ProductID") = Null
    Else
        rs("ProductID") = CLng(vProductID)
    End If
End Property

Public Property Get UnitPrice() As Variant
    UnitPrice = rs("UnitPrice")
End Property
Public Property Let UnitPrice(vUnitPrice As Variant)
    If IsNull(vUnitPrice) Then
        rs("UnitPrice") = Null
    Else
        rs("UnitPrice") = CCur(vUnitPrice)
    End If
End Property

Public Property Get Quantity() As Variant
    Quantity = rs("Quantity")
End Property
Public Property Let Quantity(vQuantity As Variant)
    If IsNull(vQuantity) Then
        rs("Quantity") = Null
    Else
        rs("Quantity") = CInt(vQuantity)
    End If
End Property

'The RecordSet Beginnig Of File status.
Public Property Get BOF() As Boolean
    BOF = rs.BOF
End Property

'The RecordSet End Of File status.
Public Property Get EOF() As Boolean
    EOF = rs.EOF
End Property

'The RecordSet AbsolutePosition property.
Public Property Let AbsolutePosition(lAbsolutePosition As Long)
    rs.AbsolutePosition = lAbsolutePosition
End Property

Public Property Get AbsolutePosition() As Long
    AbsolutePosition = rs.AbsolutePosition
End Property

'The Foreign Key Descriptor properties.
Public Property Get CustomersCompanyName() As Variant
    CustomersCompanyName = rs("CustomersCompanyName")
End Property
Public Property Let CustomersCompanyName(vCompanyName As Variant)
    rs("CustomersCompanyName") = vCompanyName
End Property

Private Sub Class_GetDataMember(DataMember As String, Data As Object)
'=============================================================
'Name: Class_GetDataMember
'
'Author: Microsoft Data Object Wizard
'
'Date: 06/11/1998 18:39
'
'Description: Creates and allows selection of RecordSet classes.
'
'Comment: A new RecordSet is created from the 'Select' RecordSet class.
'   Foreign Key Descriptor columns are added to this RecordSet class and
'   updated with the Foreign Key Data Environment commands mapped to the Select Foreign Key values.
'=============================================================

Dim i As Integer
Dim sLastFieldName As String
Dim sName() As Variant
Dim vValue() As Variant
Dim sNames As Variant
Dim vValues As Variant
Dim oField As Field

On Error GoTo errMSDOG_GDM:

bInitComplete = False

'Choose the RecordSet class based on the DataMember parameter.
Select Case LCase(DataMember)
    Case "orderinfo":
        'Skip initialization if RecordSet class already exists.
        If Not mbDataInitialized Then
            de1.rsOrderInfo.DataMember = ""

            If SaveMode = adImmediate Then
                de1.rsOrderInfo.LockType = adLockOptimistic
            Else
                de1.rsOrderInfo.LockType = adLockBatchOptimistic
            End If

            de1.OrderInfo
            'Disconnect the RecordSet class to allow (1) stored procedure access
            '  and (2) control over database update timing.
            Set de1.rsOrderInfo.ActiveConnection = Nothing

            'Data object has been initiallized.
            mbDataInitialized = True

            'Execute the Foreign Key command.
            de1.Customers
            'If there are no Foreign Keys records, exit with a ClassError event.
            If de1.rsCustomers.RecordCount < 1 Then
                Err.Clear
                Set Data = Nothing
                RaiseEvent ClassError("GetDataMember-No Customers records.", Err)
                Exit Sub
            End If

            'Set the Public property to expose the Foreign Key RecordSet class.
            Set rsCustomers = de1.rsCustomers
            'Disconnect the Foreign Key RecordSet class from the DataSource class.
            Set de1.rsCustomers.ActiveConnection = Nothing

            'Instantiate the new RecordSet class.
            Set rs = New ADODB.Recordset

            'Set the CursorType property of the RecordSet class.
            rs.CursorType = adOpenStatic
            'Set the LockType property of the RecordSet class.
            If SaveMode = adImmediate Then
                rs.LockType = adLockOptimistic
            Else
                rs.LockType = adLockBatchOptimistic
            End If

            i = -1
            sLastFieldName = ""

            'Loop through each field in the Select command,
    'adding the field to the created RecordSet class.
    'If the field is the last field in an Foreign Key command,
    'then add the Foreign Key Descriptor field.
            For Each oField In de1.rsOrderInfo.Fields
                'Is the Select field the last one in an Foreign Key command?
                Select Case LCase(sLastFieldName)
                    Case "customerid"
                        i = i + 1
                        ReDim Preserve sName(i)
                        sName(i) = "CustomersCompanyName"
                        'Add the Foreign Key Descriptor field to the RecordSet class.
                        rs.Fields.Append "CustomersCompanyName", _
                            de1.rsCustomers.Fields("CompanyName").Type, _
                            de1.rsCustomers.Fields("CompanyName").DefinedSize, _
                            de1.rsCustomers.Fields("CompanyName").Attributes
                End Select

                i = i + 1

                ReDim Preserve sName(i)

                sName(i) = oField.Name

                'Add the Select field to the RecordSet class.
                rs.Fields.Append oField.Name, oField.Type, oField.DefinedSize, oField.Attributes

                'Set the Precision property to the same as in the original RecordSet class.
                rs.Fields(i).Precision = oField.Precision
                'Set the NumericScale property to the same as in the original RecordSet class.
                rs.Fields(i).NumericScale = oField.NumericScale

                sLastFieldName = sName(i)
            Next oField

            'Open the newly created RecordSet class.
            rs.Open

            'Move to the first record in the RecordSet class.
            If de1.rsOrderInfo.RecordCount > 0 Then
                de1.rsOrderInfo.MoveFirst
            End If

            'Loop through each record in the RecordSet class.
    'If the Select field is a Foreign Key Descriptor field, look up it's value
    'in the Foreign Key command Descriptor field, then update the
    'Select Foreign Key Descriptor field with that value.
            While Not de1.rsOrderInfo.EOF
                i = -1
                sLastFieldName = ""
                For Each oField In de1.rsOrderInfo.Fields
                    'Is the field a Foreign Key Descriptor field?
                    Select Case LCase(sLastFieldName)
                        Case "customerid"
                            i = i + 1
                            ReDim Preserve vValue(i)
                            vValue(i) = Null
                            de1.rsCustomers.MoveFirst

                            'Loop through the Foreign Key RecordSet class until the Select value is found.
                            Do While Not de1.rsCustomers.EOF
                            'If the Select Foreign Key values equal the Foreign Key command Primary Key values, update the Foreign Key Descriptor field.
                                If _
                                de1.rsCustomers("customerid") = de1.rsOrderInfo("customerid") Then
                                    'Load the vValue Array element with the Foreign Key Descriptor value.
                                    vValue(i) = de1.rsCustomers("CompanyName")

                                    Exit Do
                                End If

                                'Move to the next record with a Foreign Key attribute.
                                de1.rsCustomers.MoveNext
                            Loop

                            'If the value is null, then set the Foreign Key Descriptor Array element value to '(None).
                            If IsNull(vValue(i)) Then
                                vValue(i) = "(None)"
                            End If
                    End Select

                    i = i + 1

                    ReDim Preserve vValue(i)

                    'Set the Array element equal to the value in the Select field.
                    vValue(i) = de1.rsOrderInfo(oField.Name).Value

                    sLastFieldName = oField.Name
                Next oField

                'To add a record to a RecordSet class two arrays of variants are required,
    '(1) an array of field names and (2) an array of corresponding values.
                sNames = sName()
                vValues = vValue()

                'Add the record to the created RecordSet class.
                rs.AddNew sNames, vValues

                'Move to the next record in the Select RecordSet class.
                de1.rsOrderInfo.MoveNext
            Wend

            'Move to the first record in the created RecordSet class.
            rs.MoveFirst
        End If

        'Update all the RecordSet class row status to 'unmodified'.
        rs.UpdateBatch

        'ReDimension the array to hold system generated Primary Key values.
        ReDim vPKValues(2, 0)

        'Set the Data object to return the Select RecordSet class to the calling procedure.
        Set Data = rs

    Case "customers"
        'Set the Data object to return the Foreign Key RecordSet class to the calling procedure.
        Set Data = de1.rsCustomers
End Select

bInitComplete = True

Exit Sub
errMSDOG_GDM:
    RaiseEvent ClassError("GetDataMember", Err)
End Sub

Private Sub Class_Initialize()
'=============================================================
'Name: Class_Initialize
'
'Author: Microsoft Data Object Wizard
'
'Date: 06/11/1998 18:39
'
'Description: Standard Class object Initialize event.
'
'Comment:
'=============================================================

    'Reset the Initialization variable.
    mbDataInitialized = False
End Sub

Private Sub Class_Terminate()
'=============================================================
'Name: Class_Terminate
'
'Author: Microsoft Data Object Wizard
'
'Date: 06/11/1998 18:39
'
'Description: Closes Data Environment connections and uninitializes objects
'
'Comment:
'=============================================================

    'Close the Data Environment connection
    de1.Connection1.Close
    'Release the Data Environment and RecordSet objects
    Set de1 = Nothing
    Set rs = Nothing
End Sub


Private Sub RS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, _
        ByVal pError As ADODB.Error, _
        adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'=============================================================
'Name: RS_MoveComplete
'
'Author: Microsoft Data Object Wizard
'
'Date: 06/11/1998 18:39
'
'Description: Standard RecordSet MoveComplete event.
'
'Comment:
'=============================================================

    'Exit the subroutine if the Beginning Of File property is true
    If rs.BOF Then
        Exit Sub
    End If

    'Exit the subroutine if the End Of File Property is true
    If rs.EOF Then
        Exit Sub
    End If

    'Raise the rsMoveComplete event

    RaiseEvent rsMoveComplete

End Sub

Public Sub Move(lRows As Long)
'=============================================================
'Name: Move
'
'Author: Microsoft Data Object Wizard
'
'Date: 06/11/1998 18:39
'
'Description: Move the RecordSet n number of Rows.
'
'Comment:
'=============================================================

    On Error GoTo errMove:

    rs.Move lRows

Exit Sub
errMove:
End Sub

Public Sub MoveNext()
'=============================================================
'Name: MoveNext
'
'Author: Microsoft Data Object Wizard
'
'Date: 06/11/1998 18:39
'
'Description: Move to next record.
'
'Comment:
'=============================================================

    If (rs.RecordCount > 0) And (Not rs.EOF) Then
        rs.MoveNext
    End If
End Sub

Public Sub MoveFirst()
'=============================================================
'Name: MoveFirst
'
'Author: Microsoft Data Object Wizard
'
'Date: 06/11/1998 18:39
'
'Description: Move to first record.
'
'Comment:
'=============================================================

    If rs.RecordCount > 0 Then
        rs.MoveFirst
    End If
End Sub

Public Sub MovePrevious()
'=============================================================
'Name: MovePrevious
'
'Author: Microsoft Data Object Wizard
'
'Date: 06/11/1998 18:39
'
'Description: Move to previous record.
'
'Comment:
'=============================================================

    If (rs.RecordCount > 0) And (Not rs.BOF) Then
        rs.MovePrevious
    End If
End Sub

Public Sub MoveLast()
'=============================================================
'Name: MoveLast
'
'Author: Microsoft Data Object Wizard
'
'Date: 06/11/1998 18:39
'
'Description: Move to last record.
'
'Comment:
'=============================================================

    If rs.RecordCount > 0 Then
        rs.MoveLast
    End If
End Sub


Public Function ValidateData() As Boolean
'=============================================================
'Name: ValidateData
'
'Author: Microsoft Data Object Wizard
'
'Date: 06/11/1998 18:39
'
'Description: This Function validates the RecordSet class data.
'
'Comment:
'=============================================================

    Dim i As Long

    ValidateData = False

    For i = 0 To rs.Fields.Count - 1
        Select Case LCase(rs.Fields(i).Name)
            Case "orderid", "customerid", "orderdate", "productid", "unitprice", "quantity"
                If IsEmpty(rs(i)) And Not rs(i).Type = adBoolean Then
                    MsgBox rs(i).Name & " error."
                    Exit Function
                End If
        End Select
    Next i

    'Verify the integer field contains a valid value.
    If Not IsNull(rs("OrderID")) Then
        If Not IsNumeric(rs("OrderID")) _
            And InStr(rs("OrderID"), ".") = 0 Then
            MsgBox "The field ' OrderID ' does not contain a valid number."
        Exit Function
        End If
    End If

    'Verify the text field contains text.
    If Not IsNull(rs("CustomerID")) Then
        If Len(Trim(rs("CustomerID"))) = 0 Then
            MsgBox "The field ' CustomerID ' does not contain valid text."
            Exit Function
        End If
    End If

    'Verify the date field contains a valid date.
    If Not IsNull(rs("OrderDate")) Then
        If Not IsDate(rs("OrderDate")) Then
            MsgBox "The field ' OrderDate ' does not contain a valid date."
            Exit Function
        End If
    End If

    'Verify the integer field contains a valid value.
    If Not IsNull(rs("ProductID")) Then
        If Not IsNumeric(rs("ProductID")) _
            And InStr(rs("ProductID"), ".") = 0 Then
            MsgBox "The field ' ProductID ' does not contain a valid number."
        Exit Function
        End If
    End If

    'Verify the decimal field contains a valid value.
    If Not IsNull(rs("UnitPrice")) Then
        If Not IsNumeric(rs("UnitPrice")) Then
            MsgBox "The field ' UnitPrice ' does not contain a valid numeric value."
            Exit Function
        End If
    End If

    'Verify the integer field contains a valid value.
    If Not IsNull(rs("Quantity")) Then
        If Not IsNumeric(rs("Quantity")) _
            And InStr(rs("Quantity"), ".") = 0 Then
            MsgBox "The field ' Quantity ' does not contain a valid number."
        Exit Function
        End If
    End If


    ValidateData = True

End Function

Public Sub UpdateBatch()
'=============================================================
'Name: Update Batch
'
'Author: Microsoft Data Object Wizard
'
'Date: 06/11/1998 18:39
'
'Description: Saves all modified records.
'
'Comment:
'=============================================================

    On Error GoTo errUpdateBatch:


    rs.UpdateBatch

    Exit Sub
errUpdateBatch:
    RaiseEvent ClassError("UpdateBatch", Err)
End Sub


Public Sub Update()
'=============================================================
'Name: Update
'
'Author: Microsoft Data Object Wizard
'
'Date: 06/11/1998 18:39
'
'Description: Saves a single record of the record set.
'
'Comment:
'=============================================================

    On Error GoTo errUpdate:

    rs.UpdateBatch adAffectCurrent

    Exit Sub

errUpdate:
    RaiseEvent ClassError("Update", Err)
End Sub


Public Sub AddRecord()
'=============================================================
'Name: AddRecord
'
'Author: Microsoft Data Object Wizard
'
'Date: 06/11/1998 18:39
'
'Description: Adds a blank record to the RecordSet class.
'
'Comment: .
'=============================================================

    mbAddingRecord = True

    With rs
        .AddNew
        .Update
    End With

    mbAddingRecord = False

    rs.MoveLast

End Sub


Private Sub UpdateCustomersCompanyName()
'=============================================================
'Name: UpdateCustomersCompanyName
'
'Author: Microsoft Data Object Wizard
'
'Date: 06/11/1998 18:39
'
'Description: Updates Foreign Key Descriptor field.
'
'Comment:
'=============================================================

    de1.rsCustomers.MoveFirst

    rs("CustomersCompanyName") = "(None)"
    CustomersCompanyName = "(None)"

    While Not de1.rsCustomers.EOF
        If _
            de1.rsCustomers("customerid") = rs("customerid") Then
                rs("CustomersCompanyName") = CStr(de1.rsCustomers("CompanyName"))
                CustomersCompanyName = CStr(de1.rsCustomers("CompanyName"))
        End If

        de1.rsCustomers.MoveNext
    Wend
End Sub

Public Sub rsUpdate(vFieldName As Variant)
'=============================================================
'Name: rsUpdate
'
'Author: Microsoft Data Object Wizard
'
'Date: 06/11/1998 18:39
'
'Description: Updates Foreign Key Descriptors and raises rsUpdate event
'
'Comment:
'=============================================================

    UpdateCustomersCompanyName

    RaiseEvent rsUpdateEvent(vFieldName)
End Sub

Public Sub Delete()
'=============================================================
'Name: Delete
'
'Author: Microsoft Data Object Wizard
'
'Date: 06/11/1998 18:39
'
'Description: This subroutine deletes a single record.
'
'Comment:
'=============================================================

    On Error GoTo errDelete

    mbDeleteInProgress = True

    On Error GoTo 0

    Me.MovePrevious

    mbDeleteInProgress = False

    Exit Sub

errDelete:
    RaiseEvent ClassError("Delete", Err)
End Sub


Private Sub rs_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'=============================================================
'Name: rs_WillChangeRecord
'
'Author: Microsoft Data Object Wizard
'
'Date: 06/11/1998 18:39
'
'Description: Runs stored procedures to save record.
'
'Comment:
'=============================================================

On Error GoTo errWillChangeRecord
    If bInitComplete And (adReason <> adRsnFirstChange) And (adReason <> adRsnUndoAddNew) And Not mbAddingRecord Then
        If IsEmpty(rs(0).OriginalValue) Then
        Else
            Select Case adReason
                Case adRsnUpdate
                    If Not mbDeleteInProgress Then
                    End If
                Case adRsnAddNew
                Case adRsnDelete
                    mbDeleteInProgress = True
            End Select
        End If
    End If

    Exit Sub

errWillChangeRecord:

End Sub


Private Function GetPKValue(vBookMark As Variant, sColName As String) As Variant
'=============================================================
'Name: GetPKValue
'
'Author: Microsoft Data Object Wizard
'
'Date: 06/11/1998 18:39
'
'Description: Looks up newly inserted system gen'd PK values.
'
'Comment:
'=============================================================

    Dim i As Integer

    GetPKValue = rs(sColName)

    For i = 1 To UBound(vPKValues, 2)
        If vPKValues(0, i) = vBookMark And LCase(vPKValues(1, i)) = LCase(sColName) Then
            GetPKValue = vPKValues(2, i)
            Exit Function
        End If
    Next i
End Function