frmedit.frm

这是一个家庭信息管理的小软件！

         Caption         =   "&Edit"
         Height          =   300
         Left            =   120
         TabIndex        =   9
         Top             =   240
         Width           =   900
      End
   End
End
Attribute VB_Name = "frmEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**********************************************************************
'**********************************************************************
Option Explicit
 'Variable Declaration
  Public Edit_SQL As String
  Dim Edit_Database As Database
  Dim Edit_Recordset As Recordset
 'Used for temporary storage
  Dim TmpFName As String
  Dim TmpLName As String
  Dim TmpRelation As String
'**********************************************************************
'**********************************************************************

'**********************************************************************
'**********************************************************************
Private Sub btnCancel_Click()
  Unload Me
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub btnDelete_Click()
 'Delete
  On Error GoTo DelErr
  Dim DelMSG As VbMsgBoxResult
  DelMSG = MsgBox(" Are You Sure That You Want To Delete This Record", vbQuestion + vbYesNo)
  If DelMSG = vbYes Then
     Edit_Recordset.Delete
  End If
  Unload Me
DelErr:
  If Err.Number <> 0 Then
     MsgBox "An error has been encountered while trying to delete a record. Error:" & Str(Err.Number) & " " & Err.Description, vbCritical + vbOKOnly
     Err.Clear
     Unload Me
  End If
End Sub
'**********************************************************************
'**********************************************************************



'**********************************************************************
'**********************************************************************
Private Sub btnEdit_Click()
  'Edit
   Call Editing
   First_Name.SetFocus
End Sub
'**********************************************************************
'**********************************************************************



'**********************************************************************
'**********************************************************************
Private Sub btnSave_Click()
  Dim SaveMSG As VbMsgBoxResult
  On Error GoTo SaveErr
  SaveMSG = MsgBox("Do You Want To Save The Changes", vbQuestion + vbYesNo)
  
  If SaveMSG = vbYes Then
    'Check For Invalid Characters ( ' & _  & ")
     If InStr(First_Name.Text, "'") > 0 Then
        MsgBox " Please Remove the Apostrophe(/s) ['] from the First Name field", vbInformation + vbOKOnly
        Exit Sub
     End If
     
     If InStr(First_Name.Text, "_") > 0 Then
        MsgBox " Please Remove the Underscore(/s) [_] from the First Name field", vbInformation + vbOKOnly
        Exit Sub
     End If
       
     If InStr(Last_Name.Text, "'") > 0 Then
        MsgBox " Please Remove the Apostrophe(/s) ['] from the Last Name field", vbInformation + vbOKOnly
        Exit Sub
     End If
     
     If InStr(Last_Name.Text, "_") > 0 Then
        MsgBox " Please Remove the Underscore(/s) [_] from the Last Name field", vbInformation + vbOKOnly
        Exit Sub
     End If
           
     If InStr(First_Name.Text, Chr$(34)) > 0 Then
        MsgBox " Please Remove the Quote(/s) [ " & Chr$(34) & " ] from the First Name field", vbInformation + vbOKOnly
        Exit Sub
     End If
     
     If InStr(Last_Name.Text, Chr$(34)) > 0 Then
        MsgBox " Please Remove the Quote(/s) [ " & Chr$(34) & " ] from the Last Name field", vbInformation + vbOKOnly
        Exit Sub
     End If
          
     If Len(Trim(Last_Name.Text)) < 1 Then
        Last_Name.Text = "Unknown"
     End If

     First_Name.Text = Trim(First_Name.Text)
     If Len(Trim(First_Name.Text)) < 3 Then
        MsgBox "Note: The First Name Field should contain at least 3 characters", vbInformation + vbOKOnly
        Exit Sub
     End If
        
    'check if the record already exists
     If (TmpFName = First_Name.Text) And (TmpLName = Last_Name.Text) And (TmpRelation = Relation.Text) Then
        Edit_Recordset.Edit
        Edit_Recordset.Fields("FirstName") = First_Name.Text
        Edit_Recordset.Fields("LastName") = Last_Name.Text
        Edit_Recordset.Fields("Sex") = Sex.Text
        Edit_Recordset.Fields("Relation") = Relation.Text
        Edit_Recordset.Fields("Telephone") = Telephone.Text
        Edit_Recordset.Fields("Address") = Address.Text
        Edit_Recordset.Fields("City_State") = City_State.Text
        Edit_Recordset.Fields("ZipCode") = ZipCode.Text
        Edit_Recordset.Fields("EmailAddress") = Email.Text
        Edit_Recordset.Update
        Edit_Recordset.Close
       Else
        If Record_Exist(Current_LoginName, First_Name.Text, Last_Name.Text, Relation.Text) = True Then
           MsgBox "Sorry " & Current_LoginName & ", but this record already exists.", vbInformation + vbOKOnly
           Exit Sub
          Else
           Edit_Recordset.Edit
           Edit_Recordset.Fields("FirstName") = First_Name.Text
           Edit_Recordset.Fields("LastName") = Last_Name.Text
           Edit_Recordset.Fields("Sex") = Sex.Text
           Edit_Recordset.Fields("Relation") = Relation.Text
           Edit_Recordset.Fields("Telephone") = Telephone.Text
           Edit_Recordset.Fields("Address") = Address.Text
           Edit_Recordset.Fields("City_State") = City_State.Text
           Edit_Recordset.Fields("ZipCode") = ZipCode.Text
           Edit_Recordset.Fields("EmailAddress") = Email.Text
           Edit_Recordset.Update
           Edit_Recordset.Close
        End If
     End If
  End If
  
  Unload Me
  
SaveErr:
 If Err.Number <> 0 Then
    MsgBox "An error has been encountered while trying to save changes. Error:" & Str(Err.Number) & " " & Err.Description, vbCritical + vbOKOnly
    Err.Clear
 End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub First_Name_KeyPress(KeyAscii As Integer)
  If (KeyAscii = 95) Or (KeyAscii = 39) Or (KeyAscii = 34) Then
     MsgBox "Sorry, but the character ( " & Chr(KeyAscii) & " ) that is an invalid character", vbInformation + vbOKOnly
     KeyAscii = 0
  End If
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub Form_Load()
  frmEdit_Editting = True
  frmSearch.Enabled = False
  If Init_Edit <> True Then Unload Me
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Sub Form_Unload(Cancel As Integer)
 'Set The Form NotOntop
 'Call Set_Form_NotOnTop(frmEdit)
  
  Set Edit_Database = Nothing
  Set Edit_Recordset = Nothing
  Edit_SQL = ""

  frmSearch.WindowState = vbNormal
  frmSearch.Show
  frmSearch.Enabled = True
  frmEdit_Editting = False
  frmSearch.SrchBtn_Click
End Sub
'**********************************************************************
'**********************************************************************


'**********************************************************************
'**********************************************************************
Private Function Init_Edit() As Boolean
  On Error GoTo InitErr
  btnSave.Enabled = False
  btnCancel.Enabled = False
  btnEdit.Enabled = True
  btnDelete.Enabled = True
 
 'Load the Combos
  Sex.Clear
  Sex.AddItem "Male"
  Sex.AddItem "Female"
  Sex.ListIndex = 0
   
  Relation.Clear
  Relation.AddItem "Family"
  Relation.AddItem "Spouse"
  Relation.AddItem "Friend"
  Relation.AddItem "Co-Worker"
  Relation.AddItem "Acquaintance"
  Relation.ListIndex = 0
 '-------------------------------------------
 'Lock Fields
  First_Name.Locked = True
  Last_Name.Locked = True
  Sex.Locked = True
  Relation.Locked = True
  Telephone.Locked = True
  Address.Locked = True
  City_State.Locked = True
  ZipCode.Locked = True
  Email.Locked = True
  
 'Open Database
  Set Edit_Database = OpenDatabase(Database_Path & "\" & Database_Name, False, False, ";pwd=" & Database_Password)
  Set Edit_Recordset = Edit_Database.OpenRecordset("SELECT * FROM " & Current_LoginName & Edit_SQL)
  Edit_Recordset.Fields.Refresh
  Edit_Recordset.MoveFirst
  
  If Edit_Recordset.RecordCount > 0 Then
     Init_Edit = True
    Else
     Init_Edit = False
     Exit Function
  End If
  
  First_Name.Text = Edit_Recordset.Fields("FirstName")
  Last_Name.Text = Edit_Recordset.Fields("LastName")
  Sex.Text = Edit_Recordset.Fields("Sex")
  Relation.Text = Edit_Recordset.Fields("Relation")
  Telephone.Text = Edit_Recordset.Fields("Telephone")
  Address.Text = Edit_Recordset.Fields("Address")
  City_State.Text = Edit_Recordset.Fields("City_State")
  ZipCode.Text = Edit_Recordset.Fields("ZipCode")
  Email.Text = Edit_Recordset.Fields("EmailAddress")
  
  TmpFName = First_Name.Text
  TmpLName = Last_Name.Text
  TmpRelation = Relation.Text

  Me.Caption = Current_LoginName & "[Edditing-" & First_Name.Text & "]"
  
InitErr:
 If Err.Number <> 0 Then
    MsgBox "An error has been encountered while trying to initialize the database. Error:" & Str(Err.Number) & " " & Err.Description, vbCritical + vbOKOnly
    Init_Edit = False
    Err.Clear
 End If
End Function
'**********************************************************************
'**********************************************************************



'**********************************************************************
'**********************************************************************
Private Sub Editing()
  btnSave.Enabled = True
  btnCancel.Enabled = True
  btnEdit.Enabled = False
  btnDelete.Enabled = False

 'Unlock Fields
  First_Name.Locked = False
  Last_Name.Locked = False
  Sex.Locked = False
  Relation.Locked = False
  Telephone.Locked = False
  Address.Locked = False
  City_State.Locked = False
  ZipCode.Locked = False
  Email.Locked = False
End Sub
'**********************************************************************
'**********************************************************************



'**********************************************************************
'**********************************************************************
Private Sub Last_Name_KeyPress(KeyAscii As Integer)
  If (KeyAscii = 95) Or (KeyAscii = 39) Or (KeyAscii = 34) Then
     MsgBox "Sorry, but the character ( " & Chr(KeyAscii) & " ) that is an invalid character", vbInformation + vbOKOnly
     KeyAscii = 0
  End If
End Sub
'**********************************************************************
'**********************************************************************