vrental_engine.cls

ado+ACCE

   ReportFileStatus = msg
End Function
Function GetDayCount(FirstDate As String, SecondDate As String) As Integer
    GetDayCount = Abs(DateSerial(Year(SecondDate), Format(SecondDate, "MM"), Day(SecondDate)) - DateSerial(Year(FirstDate), Format(FirstDate, "MM"), Day(FirstDate)))
End Function
Function Round(RoundMe, RoundTo) As Double
    Round = Int((RoundMe * 10 ^ RoundTo) + 0.5) / 10 ^ RoundTo
   
End Function

Sub LoadUsers(lst As ListBox)  ''load UserNames in a 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\UsersDB.mdb" _
             , False, False, ";pwd=AdmiN")
    Set rec = db.OpenRecordset("Users", 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") & " (" & rec.Fields("User Name") & ")"
            rec.MoveNext
        Next loop1
     End If
     
  db.Close
  Exit Sub
  
ErrorHandler:
    db.Close

End Sub
Sub getUserInfo(txtUserID As TextBox, txtDateEntered As TextBox, _
                txtUserName As TextBox, txtPassword As TextBox, _
                txtAccessLevel As TextBox, txtFirstName As TextBox, _
                txtMiddleName As TextBox, txtFamilyName As TextBox, _
                txtBirthday As TextBox, txtSex As TextBox, _
                txtHomeAddress As TextBox, txtContactNumber As TextBox, _
                txtComments As TextBox, txtConfirmPassword As TextBox, lst As ListBox)
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\UsersDB.mdb" _
             , False, False, ";pwd=AdmiN")
    Set rec = db.OpenRecordset("Users", 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("First Name") & " " & Left(rec.Fields("Middle Name"), 1) & ". " & _
                          rec.Fields("Family Name") & " (" & rec.Fields("User Name") & ")" Then
                    txtUserID.Text = rec.Fields("UserID")
                    txtDateEntered.Text = Format(rec.Fields("Date Entered"), "mmm. d, yyyy")
                    txtUserName.Text = rec.Fields("User Name")
                    txtPassword.Text = rec.Fields("Password")
                    txtConfirmPassword.Text = txtPassword.Text
                    txtAccessLevel.Text = rec.Fields("AccessLevel")
                    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. d, yyyy")
                    txtSex.Text = rec.Fields("Sex")
                    txtHomeAddress.Text = rec.Fields("Home Address")
                    txtContactNumber.Text = rec.Fields("Contact Number")
                    txtComments.Text = rec.Fields("Comments")
                    db.Close
                    Exit Sub
            End If
            rec.MoveNext
        Next loop1
     End If
     
  db.Close
  
Err:
  txtDateEntered.Text = ""
  txtUserID.Text = ""

End Sub

Function UpdateEditedUsersDB(txtUserName As TextBox, txtPassword As TextBox, _
                txtAccessLevel As TextBox, txtFirstName As TextBox, _
                txtMiddleName As TextBox, txtFamilyName As TextBox, _
                txtBirthday As TextBox, txtSex As TextBox, _
                txtHomeAddress As TextBox, txtContactNumber As TextBox, _
                txtComments As TextBox, lst As ListBox) As Boolean
'On Error GoTo ErrorHandler
    Dim db As Database
    Dim rec As Recordset
    Dim TDM As Variant
    Dim loop1 As Integer
    
    Set db = OpenDatabase(App.Path & "\Database\UsersDB.mdb" _
             , False, False, ";pwd=AdmiN")
    Set rec = db.OpenRecordset("Users", dbOpenTable)
    ''---------------------------------------------
    If rec.BOF = True And rec.EOF = True Then
    rec.AddNew
                 rec.Fields("Date Entered") = Date$
                 rec.Fields("UserID") = 1 '1st record
                 rec.Fields("User Name") = Trim(txtUserName.Text)
                 rec.Fields("Password") = Trim(txtPassword.Text)
                 rec.Fields("AccessLevel") = Trim(txtAccessLevel.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") = Trim(txtBirthday.Text)
                 rec.Fields("Sex") = Trim(txtSex.Text)
                 rec.Fields("Home Address") = Trim(txtHomeAddress.Text)
                 rec.Fields("Contact Number") = Trim(txtContactNumber.Text)
                 rec.Fields("Comments") = Trim(txtComments.Text)
                 rec.Update  ''Update the recordset
               '' End update fields
               db.Close  '' Close DB
    
    UpdateEditedUsersDB = True
    Exit Function
    End If
    ''---------------------------------------------
    rec.MoveFirst
    '' Start Chk for duplicates sql
    '' End -- chk duplicates
    If rec.RecordCount > 0 Then
        For loop1 = 1 To rec.RecordCount
            TDM = DoEvents()
            If lst.Text = rec.Fields("First Name") & " " & Left(rec.Fields("Middle Name"), 1) & ". " & _
                          rec.Fields("Family Name") & " (" & rec.Fields("User Name") & ")" Then
               '' Start update fields
              
                 rec.Edit
                 rec.Fields("User Name") = Trim(txtUserName.Text)
                 rec.Fields("Password") = Trim(txtPassword.Text)
                 rec.Fields("AccessLevel") = Trim(txtAccessLevel.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") = Trim(txtBirthday.Text)
                 rec.Fields("Sex") = Trim(txtSex.Text)
                 rec.Fields("Home Address") = Trim(txtHomeAddress.Text)
                 rec.Fields("Contact Number") = Trim(txtContactNumber.Text)
                 rec.Fields("Comments") = Trim(txtComments.Text)
                 rec.Update  ''Update the recordset
               '' End update fields
               db.Close  '' Close DB
               UpdateEditedUsersDB = True
               Exit Function
            End If
            rec.MoveNext
        Next loop1
     End If
     
  db.Close
  UpdateEditedUsersDB = True
  Exit Function
  
ErrorHandler:
  MsgBox "Your chosen User Name is already in use. " & vbCrLf & vbCrLf & "Change your User Name. ", vbInformation, "Update Error"
UpdateEditedUsersDB = False
End Function

Function AddUserToDB(txtDateEntered As TextBox, txtUserName As TextBox, txtPassword As TextBox, _
                txtAccessLevel As TextBox, txtFirstName As TextBox, _
                txtMiddleName As TextBox, txtFamilyName As TextBox, _
                txtBirthday As TextBox, txtSex As TextBox, _
                txtHomeAddress As TextBox, txtContactNumber 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\UsersDB.mdb" _
             , False, False, ";pwd=AdmiN")
    Set rec = db.OpenRecordset("Users", 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("UserID")) = 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 check for username duplicate
                    rec.MoveFirst
                    Do While (rec.EOF = False)
                        TDM = DoEvents()
                        If rec.Fields("User Name") = Trim(txtUserName.Text) Then
                                MsgBox "Someone has already chosen your User Name. " & vbCrLf & vbCrLf & "Change your User Name. ", vbInformation, "Unable to add user"
                                db.Close
                                txtUserName.SetFocus
                                AddUserToDB = False
                                Exit Function
                        End If
                        If rec.EOF = False Then rec.MoveNext
                    Loop
     '' End check for username duplicate
                '' Start update new record fields
                 rec.AddNew
                 rec.Fields("UserID") = AutoNumber
                 rec.Fields("Date Entered") = Format(txtDateEntered.Text, "mm-dd-yyyy")
                 rec.Fields("User Name") = Trim(txtUserName.Text)
                 rec.Fields("Password") = Trim(txtPassword.Text)
                 rec.Fields("AccessLevel") = Trim(txtAccessLevel.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") = Trim(txtBirthday.Text)
                 rec.Fields("Sex") = Trim(txtSex.Text)
                 rec.Fields("Home Address") = Trim(txtHomeAddress.Text)
                 rec.Fields("Contact Number") = Trim(txtContactNumber.Text)
                 rec.Fields("Comments") = Trim(txtComments.Text)
                 rec.Update  ''Update the recordset
               '' End update new record fields
               db.Close  '' Close DB
               MsgBox "Another user has been successfully added. ", vbInformation, "Success"
               AddUserToDB = True
End Function

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

Err:
End Sub

Sub LoadMembers(lst As ListBox) ''load UserNames in a 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\MembersDB.mdb" _
             , False, False, ";pwd=AdmiN")
    Set rec = db.OpenRecordset("MembersInfo", 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("Family Name") & ", " & rec.Fields("First Name") & " " & Left(rec.Fields("Middle Name"), 1) & "."
            rec.MoveNext
        Next loop1
     End If
     
  db.Close
  Exit Sub
  
ErrorHandler:
  db.Close
End Sub

Sub GetMemberInfo(lst As ListBox, 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)     'Load member info to textboxes


    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")