numMonths = (numyears - Int(numyears)) * 365.25 / 30.4583
 GetAge = Int(numyears)
End Function
Function ReportFileStatus(filespec) As Boolean '' Check if file is present 檢查文件是否整備就緒
   Dim fso, msg
   Set fso = CreateObject("Scripting.FileSystemObject")
   If (fso.FileExists(filespec)) Then
      msg = -1
   Else
      msg = 0
   End If
   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)  '定義過程：連接Users表并往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("姓氏") & " (" & rec.Fields("用戶名") & ")"
            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) '連接數(shù)據(jù)庫，打開Users表里的數(shù)據(jù)記錄集
    
If rec.BOF = True And rec.EOF = True Then Exit Sub '檢查紀(jì)錄是否存在,不存在則跳出

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("姓氏") & " (" & rec.Fields("用戶名") & ")" Then
                    txtUserID.Text = rec.Fields("UserID")
                    txtDateEntered.Text = Format(rec.Fields("Date Entered"), "mmm. d, yyyy")
                    txtUserName.Text = rec.Fields("用戶名")
                    txtPassword.Text = rec.Fields("密碼")
                    txtConfirmPassword.Text = txtPassword.Text
                    txtAccessLevel.Text = rec.Fields("會員權(quán)限")
                    txtFirstName.Text = rec.Fields("First Name")
                    txtMiddleName.Text = rec.Fields("Middle Name")
                    txtFamilyName.Text = rec.Fields("姓氏")
                    txtBirthday.Text = Format(rec.Fields("生日"), "mmm. d, yyyy")
                    txtSex.Text = rec.Fields("性別")
                    txtHomeAddress.Text = rec.Fields("家庭住址")
                    txtContactNumber.Text = rec.Fields("聯(lián)系號碼")
                    txtComments.Text = rec.Fields("使用評價")
                    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 如發(fā)生錯誤則跳轉(zhuǎn)到 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("用戶名") = Trim(txtUserName.Text)
                 rec.Fields("密碼") = Trim(txtPassword.Text)
                 rec.Fields("會員權(quán)限") = Trim(txtAccessLevel.Text)
                 rec.Fields("First Name") = Trim(txtFirstName.Text)
                 rec.Fields("Middle Name") = Trim(txtMiddleName.Text)
                 rec.Fields("姓氏") = Trim(txtFamilyName.Text)
                 rec.Fields("生日") = Trim(txtBirthday.Text)
                 rec.Fields("性別") = Trim(txtSex.Text)
                 rec.Fields("家庭住址") = Trim(txtHomeAddress.Text)
                 rec.Fields("聯(lián)系號碼") = 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("姓氏") & " (" & rec.Fields("用戶名") & ")" Then
               '' Start update fields
              
                 rec.Edit
                 rec.Fields("用戶名") = Trim(txtUserName.Text)
                 rec.Fields("密碼") = Trim(txtPassword.Text)
                 rec.Fields("會員權(quán)限") = Trim(txtAccessLevel.Text)
                 rec.Fields("First Name") = Trim(txtFirstName.Text)
                 rec.Fields("Middle Name") = Trim(txtMiddleName.Text)
                 rec.Fields("姓氏") = Trim(txtFamilyName.Text)
                 rec.Fields("生日") = Trim(txtBirthday.Text)
                 rec.Fields("性別") = Trim(txtSex.Text)
                 rec.Fields("家庭住址") = Trim(txtHomeAddress.Text)
                 rec.Fields("聯(lián)系號碼") = Trim(txtContactNumber.Text)
                 rec.Fields("使用評價") = 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 "名字已經(jīng)占用！" & vbCrLf & vbCrLf & "Change your 用戶名. ", 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  檢查新ID是否合法以避免重復(fù)
        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                 '生成合法的AutoNumber后則繼續(xù)往下走...
     
     '' Start check for username duplicate    開始檢查用戶名是否重復(fù)
                    rec.MoveFirst
                    Do While (rec.EOF = False)
                        TDM = DoEvents()
                        If rec.Fields("用戶名") = Trim(txtUserName.Text) Then
                                MsgBox "這個名字已經(jīng)占用！ " & vbCrLf & vbCrLf & "Change your 用戶名. ", vbInformation, "Unable to add user"
                                db.Close
                                txtUserName.SetFocus
                                AddUserToDB = False
                                Exit Function
                        End If
                        If rec.EOF = False Then rec.MoveNext
                    Loop
                '' Start update new record fields   檢查完畢后則開始更新動作
                 rec.AddNew
                 rec.Fields("UserID") = AutoNumber
                 rec.Fields("Date Entered") = Format(txtDateEntered.Text, "mm-dd-yyyy")
                 rec.Fields("用戶名") = Trim(txtUserName.Text)
                 rec.Fields("密碼") = Trim(txtPassword.Text)
                 rec.Fields("會員權(quán)限") = Trim(txtAccessLevel.Text)
                 rec.Fields("First Name") = Trim(txtFirstName.Text)
                 rec.Fields("Middle Name") = Trim(txtMiddleName.Text)
                 rec.Fields("姓氏") = Trim(txtFamilyName.Text)
                 rec.Fields("生日") = Trim(txtBirthday.Text)
                 rec.Fields("性別") = Trim(txtSex.Text)
                 rec.Fields("家庭住址") = Trim(txtHomeAddress.Text)
                 rec.Fields("聯(lián)系號碼") = Trim(txtContactNumber.Text)
                 rec.Fields("使用評價") = Trim(txtComments.Text)
                 rec.Update  ''Update the recordset
               '' End update new record fields
               db.Close  '' Close DB
               MsgBox "新用戶記錄成功添加！ ", vbInformation, "更新成功！"
               AddUserToDB = True      '用以標(biāo)記是否往UserDB里添加過用戶
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 "已刪除此系統(tǒng)用戶！", vbInformation, "更新！"
 db.Close
Err:
End Sub
Sub LoadMembers(lst As ListBox, fw1 As String, fw2 As String) ''load UserNames in a listbox  往listbox里加載用戶名
    On Error GoTo ErrorHandler:
    Dim db As Database
    Dim rec As Recordset
    Dim TDM As Variant
    Dim loop1, loop2 As Integer
    lst.Clear
    
    Set db = OpenDatabase(App.Path & "\Database\MembersDB.mdb", False, False, ";pwd=AdmiN")
    Set rec = db.OpenRecordset("MembersInfo", dbOpenTable)
      rec.MoveFirst
          rec.MoveFirst
    If rec.RecordCount > 0 And Val(fw2) >= Val(fw1) Then
     'loop1 = rec.RecordCount + 1
       For loop2 = Val(fw1) To Val(fw2)
        rec.MoveFirst
        For loop1 = 1 To rec.RecordCount
            TDM = DoEvents()
            If rec.Fields("ID NUMBER") <> loop2 Then
            rec.MoveNext
            Else: Exit For
            End If
        Next loop1
            lst.AddItem rec.Fields("ID NUMBER") & rec.Fields("姓氏") & ", " & rec.Fields("名字1") & Left(rec.Fields("名字2"), 1)
            rec.MoveNext
        Next loop2
     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, _