Dim TR As Long
Dim ws As Workspace
Dim db As Database
Dim rs As Recordset
Dim datDate As Date



Private Sub Form_Load()
datDate = CDate(Format(Now(), "MMMM,D,YYYY"))
lblDate = datDate
lblStatus = "Program started successfully"
Provider = "Microsoft.Jet.OLEDB.4.0"
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase(App.Path & "\AB.mdb")
    With Data1
        .DatabaseName = App.Path & "\AB.mdb"
        .RecordSource = "idxAB"
        .Refresh
    End With
    'Check to see if recordcount is 0
On Error Resume Next
Data1.Recordset.MoveFirst
TR = Data1.Recordset.RecordCount
Screen.MousePointer = vbDefault
    If TR > 0 Then
        txtFields(0).Enabled = True
        txtFields(1).Enabled = True
        txtFields(2).Enabled = True
        txtFields(3).Enabled = True
        txtFields(4).Enabled = True
        txtFields(5).Enabled = True
        txtFields(6).Enabled = True
        txtFields(7).Enabled = True
        txtFields(8).Enabled = True
        cmdDelete.Enabled = True
        cmdUpdate.Enabled = True
        cmdNext.Enabled = True
        cmdPrev.Enabled = True
        cmdFind.Enabled = True
        cmdemail.Enabled = True
        mnuReport.Enabled = True
        mnuData.Enabled = True
'       Data1.Recordset.MoveFirst
        lblStatus = "Program started successfully"
        lblBar.Caption = "Record: " & (Data1.Recordset.AbsolutePosition + 1 & " of " & (Data1.Recordset.RecordCount))
    End If
    
   'Check if copy of program is already running
   If App.PrevInstance Then
      MsgBox "Address Book is already running in memory", vbOKOnly, "Address Book Running"
      ActivatePrevInstance
   End If
   Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
End Sub

Private Sub cmdAbout_Click()
'Open About form
frmAbout.Show
End Sub

Private Sub cmdAdd_Click()
'Add record
On Error GoTo ErrHandle
If TR = 0 Then
    TR = TR + 1
    txtFields(0).Enabled = True
    txtFields(1).Enabled = True
    txtFields(2).Enabled = True
    txtFields(3).Enabled = True
    txtFields(4).Enabled = True
    txtFields(5).Enabled = True
    txtFields(6).Enabled = True
    txtFields(7).Enabled = True
    txtFields(8).Enabled = True
    cmdAdd.Enabled = True
    cmdDelete.Enabled = True
    cmdNext.Enabled = True
    cmdPrev.Enabled = True
    cmdFind.Enabled = True
    cmdUpdate.Enabled = True
    cmdemail.Enabled = True
    mnuReport.Enabled = True
    mnuData.Enabled = True
End If
    txtFields(0).SetFocus
    Data1.Recordset.AddNew
    lblStatus = "Adding new record"

End_of_Proc:
Exit Sub

ErrHandle:
lblStatus = "Error number " & Err.Number & " encountered."
Select Case Err.Number
    Case 3426
        MsgBox ("Each record requires a Last & First name !"), vbOKOnly
        If txtFields(0) = "" Then
            txtFields(0).SetFocus
        Else
            txtFields(1).SetFocus
        End If
        Screen.MousePointer = vbDefault
        Resume Next
    Case Else
        MsgBox "Unknown error has been encountered Saving record!" _
        & Space(1) & "Note the Error number" & Space(1) & Err.Number, vbOKOnly
        Screen.MousePointer = vbDefault
        Resume Next
End Select
Err.Number = 0
End Sub

Private Sub cmdDelete_Click()
'Delete record
  txtFields(0).SetFocus
  TR = Data1.Recordset.RecordCount
  Data1.Recordset.Delete
  lblStatus = "Deleted Record" & Space(1) & txtFields(1) & Space(1) & txtFields(0)
  Data1.Refresh

If TR = 1 And txtFields(0).Text = "" Then
    TR = 0
    Data1.Refresh
    MsgBox "Last record removed from database!", 48
Else
    TR = TR + 1
    Data1.Refresh
End If
End Sub

Private Sub cmdemail_Click()
'Send e-mail to user listed
lblStatus = "Sending e-mail"
SendTo = txtFields(6).Text

    If SendTo = "" Then
        MsgBox "There is no email address entered!", 48, "Error sending e-mail"
        lblStatus = lblStatus & " failed."
    Else
        SendTo = "mailto:" & SendTo
        ShellExecute hwnd, "open", SendTo, vbNullString, vbNullString, SW_SHOWDEFAULT
    End If
End Sub

Private Sub cmdFind_Click()
'Search for first record matching users request
sstr = InputBox("Enter Last Name to Search")
If sstr = "" Then
    Exit Sub
Else
lblStatus = "Search Results for " & sstr
Data1.Recordset.FindFirst "Lname='" & sstr & "'"
        If Data1.Recordset.NoMatch Then
           MsgBox UCase(sstr) & " was not found in the database, check your spelling!", 48, "Search failed"
           lblStatus = lblStatus & " failed."
        End If
End If
End Sub

Private Sub cmdNext_Click()
'Move to next record if not EOF
If Data1.Recordset.BOF = True Or Data1.Recordset.EOF = True Then
    If Data1.Recordset.EOF = True Then
        MsgBox "End of file reached", 48, "Record Warning"
    End If
Else
    Data1.Recordset.MoveNext
    If txtFields(0).Text = "" Then
            MsgBox "End of file reached", 48, "Record Warning"
            Data1.Recordset.MoveLast
    End If
End If
End Sub

Private Sub cmdPrev_Click()
'Move to previous record if not at BOF
If Data1.Recordset.BOF = True Or Data1.Recordset.EOF = True Then
    If Data1.Recordset.BOF = True Then
        MsgBox "Beginning of file reached", 48, "Record Warning"
    End If
Else
    Data1.Recordset.MovePrevious
    If txtFields(0).Text = "" Then
            MsgBox "Beginning of file reached", 48, "Record Warning"
            Data1.Recordset.MoveFirst
    End If
End If
End Sub

Private Sub cmdUpdate_Click()
'Save changes to database & check for errors
On Error GoTo ErrHandle
  cmdUpdate.SetFocus
  Data1.UpdateRecord
  Data1.Recordset.Bookmark = Data1.Recordset.LastModified
  lblStatus = "Saved record" & Space(1) & txtFields(1) & Space(1) & txtFields(0)

End_of_Proc:
  Exit Sub

ErrHandle:
lblStatus = "Error number " & Err.Number & " encountered."
Select Case Err.Number
    Case 3058
        MsgBox ("Each record requires a Last & First name !"), vbOKOnly
        Resume End_of_Proc
    Case 524
        If txtFields(0) = "" Then
            MsgBox ("Last name must be filled in!"), vbOKOnly
            txtFields(0).SetFocus
        Else
            MsgBox ("First name must be filled in!"), vbOKOnly
            txtFields(1).SetFocus
        End If
    Resume End_of_Proc:
    Case 0
        Resume Next
    Case Else
        MsgBox "An error has been encountered Saving record!" _
        & Space(1) & "Note the Error number" & Space(1) & Err.Number, vbOKOnly
        
    Resume End_of_Proc:
End Select
End Sub

Private Sub cmdClose_Click()
'Close program
  Unload Me
End Sub

Private Sub Data1_Reposition()
'Update lblBar with records info
 On Error Resume Next
Screen.MousePointer = vbDefault
If TR = 0 Then
    lblStatus.Caption = "Click Add to Start"
    txtFields(0).Enabled = False
    txtFields(1).Enabled = False
    txtFields(2).Enabled = False
    txtFields(3).Enabled = False
    txtFields(4).Enabled = False
    txtFields(5).Enabled = False
    txtFields(6).Enabled = False
    txtFields(7).Enabled = False
    txtFields(8).Enabled = False
    cmdDelete.Enabled = False
    cmdUpdate.Enabled = False
    cmdNext.Enabled = False
    cmdPrev.Enabled = False
    cmdFind.Enabled = False
    cmdemail.Enabled = False
    mnuReport.Enabled = False
    mnuData.Enabled = False
    lblBar.Caption = "Database is empty"
Else
    lblBar.Caption = "Record: " & (Data1.Recordset.AbsolutePosition + 1 & " of " & (Data1.Recordset.RecordCount))
End If
End Sub

Private Sub Data1_Validate(Action As Integer, Save As Integer)
'Check for what action was taken
Select Case Action
    Case vbdataActionMaximixe
    Case vbDataActionMoveFirst
    Case vbDataActionMovePrevious
    Case vbDataActionMoveNext
    Case vbDataActionMoveLast
    Case vbDataActionAddNew
    Case vbDataActionUpdate
    Case vbDataActionDelete
    Case vbDataActionFind
    Case vbDataActionBookmark
    Case vbDataActionClose

  End Select
  Screen.MousePointer = vbHourglass
End Sub

Private Sub mnuAbout_Click()
frmAbout.Show
End Sub

Private Sub mnuDelete_Click()
'Delete record
  txtFields(0).SetFocus
  TR = Data1.Recordset.RecordCount
  Data1.Recordset.Delete
  lblStatus = "Deleted Record" & Space(1) & txtFields(1) & Space(1) & txtFields(0)
  Data1.Refresh

If TR = 1 And txtFields(0) = "" Then
    TR = 0
    Data1.Refresh
    MsgBox "Last record removed from database!", 48
Else
    TR = TR + 1
    Data1.Refresh
End If
End Sub

Private Sub mnuemail_Click()
'Send e-mail to user listed
lblStatus = "Sending e-mail"
SendTo = txtFields(6).Text

    If SendTo = "" Then
        MsgBox "There is no email address entered!", 48, "Error sending e-mail"
        lblStatus = lblStatus & " failed."
    Else
        SendTo = "mailto:" & SendTo
        ShellExecute hwnd, "open", SendTo, vbNullString, vbNullString, SW_SHOWDEFAULT
    End If
End Sub

Private Sub mnuExit_Click()
Unload Me
End Sub


Private Sub mnuNext_Click()
'Move to next record if not EOF
If Data1.Recordset.BOF = True Or Data1.Recordset.EOF = True Then
    If Data1.Recordset.EOF = True Then
        MsgBox "End of file reached", 48, "Record Warning"
    End If
Else
    Data1.Recordset.MoveNext
    If txtFields(0).Text = "" Then
            MsgBox "End of file reached", 48, "Record Warning"
            Data1.Recordset.MoveLast
    End If
End If
End Sub

Private Sub mnuPrev_Click()
'Move to previous record if not at BOF
If Data1.Recordset.BOF = True Or Data1.Recordset.EOF = True Then
    If Data1.Recordset.BOF = True Then
        MsgBox "Beginning of file reached", 48, "Record Warning"
    End If
Else
    Data1.Recordset.MovePrevious
    If txtFields(0).Text = "" Then
            MsgBox "Beginning of file reached", 48, "Record Warning"
            Data1.Recordset.MoveFirst
    End If
End If
End Sub

Private Sub mnuReadMe_Click()
ReadMe.Show
End Sub

Private Sub mnuReport_Click()
On Error GoTo ErrRpt
DataRpt.Show


End_of_Proc:
Exit Sub

ErrRpt:
Select Case Err.Number
    Case 713
        MsgBox "Missing required file Msdbrptr.dll to run the report feature", 16, "Vew Report  Critical Error"
        Resume Next
    Case Else
        MsgBox "An unknown error has halted the View Report" & Err.Number, 16, "View Report Critical Error"
        Resume Next
End Select
End Sub

Private Sub mnuSave_Click()
'Save changes to database & check for errors
On Error GoTo ErrHandle
  cmdUpdate.SetFocus
  Data1.UpdateRecord
  Data1.Recordset.Bookmark = Data1.Recordset.LastModified
  lblStatus = "Saved record" & Space(1) & txtFields(1) & Space(1) & txtFields(0)

End_of_Proc:
  Exit Sub

ErrHandle:
lblStatus = "Error number " & Err.Number & " encountered."
Select Case Err.Number
    Case 3058
        MsgBox ("Each record requires a Last & First name !"), vbOKOnly
        Resume End_of_Proc
    Case 524
        If txtFields(0) = "" Then
            MsgBox ("Last name must be filled in!"), vbOKOnly
            txtFields(0).SetFocus
        Else
            MsgBox ("First name must be filled in!"), vbOKOnly
            txtFields(1).SetFocus
        End If
    Resume End_of_Proc:
    Case 0
        Resume Next
    Case Else
        MsgBox "An error has been encountered Saving record!" _
        & Space(1) & "Note the Error number" & Space(1) & Err.Number, vbOKOnly
        
    Resume End_of_Proc:
End Select
End Sub