vrental_engine.cls

ado+ACCE

    Set rec = db.OpenRecordset("MembersInfo", dbOpenTable)
    
    If rec.BOF = True And rec.EOF = True Then Exit Sub 'chk if rec exists

rec.MoveFirst
    If rec.RecordCount > 0 Then
        For loop1 = 1 To rec.RecordCount
            TDM = DoEvents()
            If lst.Text = rec.Fields("Family Name") & ", " & rec.Fields("First Name") & " " & Left(rec.Fields("Middle Name"), 1) & "." Then
                    txtDateEntered.Text = rec.Fields("Date Entered")
                    txtIDnumber.Text = rec.Fields("ID NUMBER")
                    txtNationality.Text = rec.Fields("Membership Level")
                    txtFirstName.Text = rec.Fields("First Name")
                    txtMiddleName.Text = rec.Fields("Middle Name")
                    txtFamilyName.Text = rec.Fields("Family Name")
                    txtBirthday.Text = Format(rec.Fields("Birthday"), "mmm. dd, yyyy")
                    txtSex.Text = rec.Fields("Sex")
                    txtCivilStatus.Text = rec.Fields("Civil Status")
                    txtOccupation.Text = rec.Fields("Occupation")
                    txtContactNumber.Text = rec.Fields("Contact Number")
                    txtHomeAddress.Text = rec.Fields("Home Address")
                    txtOfficeSchoolAddress.Text = rec.Fields("OfficeOrSchool/Address")
                    txtComments.Text = rec.Fields("Comments")
                    db.Close
                    Exit Sub
            End If
            If rec.EOF = False Then rec.MoveNext
        Next loop1
     End If
     
  db.Close
  Exit Sub


End Sub

Function AddMemberToDB(txtDateEntered As TextBox, txtIDnumber As TextBox, txtNationality As TextBox, _
                  txtFirstName As TextBox, txtMiddleName As TextBox, txtFamilyName As TextBox, _
                  txtBirthday As TextBox, txtSex As TextBox, txtCivilStatus As TextBox, txtOccupation As TextBox, _
                  txtContactNumber As TextBox, txtHomeAddress As TextBox, txtOfficeSchoolAddress As TextBox, txtComments As TextBox) As Boolean
    Dim db As Database
    Dim rec As Recordset
    Dim TDM As Variant
    Dim loop1 As Integer
    Dim AutoNumber As Long
    AutoNumber = 0 ' init to zero
    Dim Valid As Boolean
    Valid = False  ' Init to False
    
    Set db = OpenDatabase(App.Path & "\Database\MembersDB.mdb" _
             , False, False, ";pwd=AdmiN")
    Set rec = db.OpenRecordset("MembersInfo", dbOpenTable)
     '' Start -- Check for valid "New ID" to avoid duplicates
     
        If rec.BOF = True And rec.EOF = True Then
                AutoNumber = 1
        Else
        
                Do
                    AutoNumber = AutoNumber + 1
                    rec.MoveFirst
                    Do While (rec.EOF = False)
                        TDM = DoEvents()
                        If Val(rec.Fields("ID NUMBER")) = AutoNumber Then
                                Valid = False
                                Exit Do
                        Else
                                Valid = True
                        End If
                        If rec.EOF = False Then rec.MoveNext
                    Loop
                Loop Until Valid = True
        End If
     '' End -- Check for valid "New ID"
     
     
                '' Start update new record fields
                 rec.AddNew
                 rec.Fields("Date Entered") = Format(Trim(txtDateEntered.Text), "mm/dd/yyyy")
                 rec.Fields("ID NUMBER") = AutoNumber
                 rec.Fields("Membership Level") = Trim(txtNationality.Text)
                 rec.Fields("First Name") = Trim(txtFirstName.Text)
                 rec.Fields("Middle Name") = Trim(txtMiddleName.Text)
                 rec.Fields("Family Name") = Trim(txtFamilyName.Text)
                 rec.Fields("Birthday") = Format(Trim(txtBirthday.Text), "mm/dd/yyyy")
                 rec.Fields("Sex") = Trim(txtSex.Text)
                 rec.Fields("Civil Status") = (txtCivilStatus.Text)
                 rec.Fields("Occupation") = Trim(txtOccupation.Text)
                 rec.Fields("Contact Number") = Trim(txtContactNumber.Text)
                 rec.Fields("Home Address") = Trim(txtHomeAddress.Text)
                 rec.Fields("OfficeOrSchool/Address") = Trim(txtOfficeSchoolAddress.Text)
                 rec.Fields("Comments") = Trim(txtComments.Text)
                 rec.Update
               '' End update new record fields
               db.Close  '' Close DB
               MsgBox "Another member has been successfully added. ", vbInformation, "Success"
               AddMemberToDB = True

End Function

Function UpdateEditedMembersDB(txtDateEntered As TextBox, txtIDnumber As TextBox, txtNationality As TextBox, _
                  txtFirstName As TextBox, txtMiddleName As TextBox, txtFamilyName As TextBox, _
                  txtBirthday As TextBox, txtSex As TextBox, txtCivilStatus As TextBox, txtOccupation As TextBox, _
                  txtContactNumber As TextBox, txtHomeAddress As TextBox, txtOfficeSchoolAddress As TextBox, txtComments As TextBox) As Boolean
  'On Error GoTo Err:
    Dim db As Database
    Dim rec As Recordset
    Dim TDM As Variant
    Dim loop1 As Integer
    
    Set db = OpenDatabase(App.Path & "\Database\MembersDB.mdb" _
             , False, False, ";pwd=AdmiN")
    Set rec = db.OpenRecordset("MembersInfo", dbOpenTable)
        
        rec.MoveFirst
    '' Start Chk for duplicates sql
    '' End -- chk duplicates
    If rec.RecordCount > 0 Then
        For loop1 = 1 To rec.RecordCount
            TDM = DoEvents()
            If Val(txtIDnumber.Text) = rec.Fields("ID NUMBER") Then
               '' Start update fields
              
                 rec.Edit
                 rec.Fields("Date Entered") = Format(Trim(txtDateEntered.Text), "mm/dd/yyyy")
                 ''''rec.Fields("ID NUMBER") = AutoNumber
                 rec.Fields("Membership Level") = Trim(txtNationality.Text) ' now used by mem level
                 rec.Fields("First Name") = Trim(txtFirstName.Text)
                 rec.Fields("Middle Name") = Trim(txtMiddleName.Text)
                 rec.Fields("Family Name") = Trim(txtFamilyName.Text)
                 rec.Fields("Birthday") = Format(Trim(txtBirthday.Text), "mm/dd/yyyy")
                 rec.Fields("Sex") = Trim(txtSex.Text)
                 rec.Fields("Civil Status") = (txtCivilStatus.Text)
                 rec.Fields("Occupation") = Trim(txtOccupation.Text)
                 rec.Fields("Contact Number") = Trim(txtContactNumber.Text)
                 rec.Fields("Home Address") = Trim(txtHomeAddress.Text)
                 rec.Fields("OfficeOrSchool/Address") = Trim(txtOfficeSchoolAddress.Text)
                 rec.Fields("Comments") = Trim(txtComments.Text)
                 rec.Update  ''Update the recordset
               '' End update fields
               db.Close  '' Close DB
               MsgBox "Member Info has been successfully updated. ", vbInformation, "Updated"
               UpdateEditedMembersDB = True
               Exit Function
            End If
            rec.MoveNext
        Next loop1
     End If
     
Err:
 db.Close
 MsgBox "An error occured while updating. ", vbInformation, "Update Error"
 UpdateEditedMembersDB = False
  
End Function

Sub RemoveMember(IDNUMBER As Long)
On Error GoTo Err:
 Dim TDM As Variant
 Dim db As Database
 Dim rec As Recordset
 
 Set db = OpenDatabase(App.Path & "\Database\MembersDB.mdb" _
             , False, False, ";pwd=AdmiN")
 Set rec = db.OpenRecordset("MembersInfo", dbOpenTable)
 rec.MoveFirst
    Do While (rec.EOF = False)
       TDM = DoEvents()
       If Val(rec.Fields("ID NUMBER")) = IDNUMBER Then
           rec.Delete
           Exit Do
       End If
       If rec.EOF = False Then rec.MoveNext
    Loop
 MsgBox "Member has been deleted. ", vbInformation, "Removed"
 db.Close

Err:
End Sub

Sub LoadMoviesList(lst As ListBox)
On Error GoTo ErrorHandler:
    Dim db As Database
    Dim rec As Recordset
    Dim TDM As Variant
    Dim loop1 As Integer
    lst.Clear
    
    Set db = OpenDatabase(App.Path & "\Database\CD_Tapes.mdb" _
             , False, False, ";pwd=AdmiN")
    Set rec = db.OpenRecordset("CD Tapes Table", dbOpenTable)
    
    rec.MoveFirst
    If rec.RecordCount > 0 Then
        For loop1 = 1 To rec.RecordCount
            TDM = DoEvents()
            'lst.AddItem rec.Fields("First Name") & " " & Left(rec.Fields("Middle Name"), 1) & ". " & _
            rec.Fields("Family Name")
            lst.AddItem rec.Fields("Title") & " [" & rec.Fields("Item Code") & "]"
            rec.MoveNext
        Next loop1
     End If
     
  db.Close
  Exit Sub
  
ErrorHandler:
  db.Close
End Sub

Sub GetCD_TapesInfo(lst As ListBox, txtTitle As TextBox, txtDateEntered As TextBox, txtItemCode As TextBox, _
                    txtActor As TextBox, txtYearReleased As TextBox, txtGenre As TextBox, txtRunTime As TextBox, txtRentalAmount As TextBox, _
                    txtAvailable As TextBox, txtRentalPeriod As TextBox, txtOverdueChargePerDay As TextBox, txtLastDateBorrowed As TextBox, txtLastDateBorrowedAddInfo As TextBox, txtLastDateReturned As TextBox, _
                    txtLastDateReturnedAddInfo As TextBox, txtCondition As TextBox, txtComments As TextBox)

    Dim db As Database
    Dim rec As Recordset
    Dim TDM As Variant
    Dim loop1 As Integer
    
    Set db = OpenDatabase(App.Path & "\Database\CD_Tapes.mdb" _
             , False, False, ";pwd=AdmiN")
    Set rec = db.OpenRecordset("CD Tapes Table", dbOpenTable)
    
    If rec.BOF = True And rec.EOF = True Then Exit Sub 'chk if rec exists

rec.MoveFirst
    If rec.RecordCount > 0 Then
        For loop1 = 1 To rec.RecordCount
            TDM = DoEvents()
            If lst.Text = rec.Fields("Title") & " [" & rec.Fields("Item Code") & "]" Then
                    txtTitle.Text = rec.Fields("Title")
                    txtDateEntered.Text = rec.Fields("Date Entered")
                    txtItemCode.Text = rec.Fields("Item Code")
                    txtActor.Text = rec.Fields("Actor")
                    txtYearReleased.Text = rec.Fields("Year Released")
                    txtGenre.Text = rec.Fields("Genre")
                    txtRunTime.Text = rec.Fields("Run Time")
                    txtRentalAmount.Text = rec.Fields("Rental Amount")
                    txtAvailable.Text = rec.Fields("Available")
                    If IsNull(rec.Fields("RentalPeriod")) = False Then
                       txtRentalPeriod.Text = rec.Fields("RentalPeriod")
                    Else
                       txtRentalPeriod.Text = ""
                    End If
                    
                    If IsNull(rec.Fields("OverdueChargePerDay")) = False Then
                       txtOverdueChargePerDay.Text = rec.Fields("OverdueChargePerDay")
                    Else
                       txtOverdueChargePerDay.Text = ""
                    End If
                    If IsNull(rec.Fields("LastDateBorrowed")) = False Then
                        txtLastDateBorrowed.Text = rec.Fields("LastDateBorrowed")
                    Else
                       txtLastDateBorrowed.Text = ""
                    End If
                    
                    If IsNull(rec.Fields("LastDateBorrowedAddInfo")) = False Then
                        txtLastDateBorrowedAddInfo.Text = rec.Fields("LastDateBorrowedAddInfo")
                    Else
                       txtLastDateBorrowedAddInfo.Text = ""
                    End If
                    
                    If IsNull(rec.Fields("LastDateReturned")) = False Then
                        txtLastDateReturned.Text = rec.Fields("LastDateReturned")
                    Else
                        txtLastDateReturned.Text = ""
                    End If
                    
                    If IsNull(rec.Fields("LastDateReturnedAddInfo")) = False Then
                        txtLastDateReturnedAddInfo.Text = rec.Fields("LastDateReturnedAddInfo")
                    Else
                       txtLastDateReturnedAddInfo.Text = ""
                    End If
                    txtCondition.Text = rec.Fields("Condition")
                    txtComments.Text = rec.Fields("Comments")
                    db.Close
                    Exit Sub
            End If
            If rec.EOF = False Then rec.MoveNext
        Next loop1
     End If
     
  db.Close
  Exit Sub

End Sub

Function Add_CD_TAPES_MovieToDB(txtTitle As TextBox, txtDateEntered As TextBox, txtItemCode As TextBox, _
                    txtActor As TextBox, txtYearReleased As TextBox, txtGenre As TextBox, txtRunTime As TextBox, txtRentalAmount As TextBox, _
                    txtAvailable As TextBox, txtRentalPeriod As TextBox, txtOverdueChargePerDay As TextBox, txtLastDateBorrowed As TextBox, txtLastDateBorrowedAddInfo As TextBox, txtLastDateReturned As TextBox, _
                    txtLastDateReturnedAddInfo As TextBox, txtCondition As TextBox, txtComments As TextBox) As Boolean
    
    Dim db As Database
    Dim rec As Recordset
    Dim TDM As Variant
    Dim loop1 As Integer
    
    Set db = OpenDatabase(App.Path & "\Database\CD_Tapes.mdb" _
             , False, False, ";pwd=AdmiN")
    Set rec = db.OpenRecordset("CD Tapes Table", dbOpenTable)
    
    If rec.BOF = True And rec.EOF = True Then
     ' Do Nothing
    Else
        'chk for item code duplicates
            rec.MoveFirst
            For loop1 = 1 To rec.RecordCount
                TDM = DoEvents()
                If Trim(txtItemCode.Text) = rec.Fields("Item Code") Then
                    MsgBox "Item Code already in use. ", vbInformation, "Adding ERROR!"
                    db.Close
                    Add_CD_TAPES_MovieToDB = False
                    Exit Function
                End If
                If rec.EOF = False Then rec.MoveNext
            Next loop1