Click to go home

This is the splash page



This is the main form




Code for main form

Option Explicit
Public WithEvents cnDatabase As ADODB.Connection

Public Sub ShowChild(strLast As String, rsContacts As Recordset) ' Create a new MDI child form Dim F As New frmContactInfo F.Height = 4335 F.Width = 4275 If strLast = "Add new Contact" Then ' Show blank form F.Caption = "Add new Contact" F.Show Else ' Show form for selected contact F.Caption = " " & strLast & " " F.Show F.txtLast.Text = rsContacts!LastName F.txtFirst.Text = rsContacts!FirstName F.mskPhone.Text = rsContacts!Phone F.mskFax.Text = rsContacts!Fax F.txtEmail.Text = rsContacts!Email F.txtAddress.Text = rsContacts!Address F.txtCity.Text = rsContacts!City F.cboProvince.Text = rsContacts!Province F.txtPostal.Text = rsContacts!PostalCode F.intContactID = frmContacts.lstContacts.ItemData(frmContacts.lstContacts.ListIndex) End If End Sub
Private Sub MDIForm_Load() On Error GoTo ErrorHandler ' Show splash screen frmSplash.Show vbModal ' Connection Set cnDatabase = New ADODB.Connection With cnDatabase .Provider = "Microsoft.Jet.OLEDB.3.51" .ConnectionString = "Data Source= Database.mdb" .Open End With Exit Sub ErrorHandler: MsgBox Err.Number & Err.Description, , "Connection" End End Sub
Private Sub MDIForm_Unload(Cancel As Integer) Unload frmContacts ' Close connection cnDatabase.Close Set cnDatabase = Nothing End Sub
Private Sub mnu15min_Click() ' Event reminder every 15 minutes mnu15min.Checked = True mnu5min.Checked = False mnu30min.Checked = False mnu60min.Checked = False End Sub
Private Sub mnu30min_Click() ' Event reminder every 30 minutes mnu5min.Checked = False mnu15min.Checked = False mnu30min.Checked = True mnu60min.Checked = False End Sub
Private Sub mnu5min_Click() ' Event reminder every 5 minutes mnu5min.Checked = True mnu15min.Checked = False mnu30min.Checked = False mnu60min.Checked = False End Sub
Private Sub mnu60min_Click() ' Event reminder every 60 minutes mnu5min.Checked = False mnu15min.Checked = False mnu30min.Checked = False mnu60min.Checked = True End Sub
Private Sub mnuComplete_Click() frmCompletedEvents.Show vbModal End Sub
Private Sub mnuCompletedList_Click() ' Open the commands for this report deContacts.EventScheduler deContacts.CompletedReport rptCompleted.Show vbModal End Sub
Private Sub mnuContactList_Click() ' Open the commands for this report deContacts.EventScheduler deContacts.ContactsReport rptContacts.Show vbModal End Sub
Private Sub mnuExit_Click() If MsgBox("Are you sure you want to quit?", vbExclamation + vbYesNo + vbDefaultButton2, "Quit") = vbYes Then Unload Me End If End Sub
Private Sub mnuHAbout_Click() frmAbout.Show vbModal End Sub
Private Sub mnuMaintenance_Click() frmContacts.Show End Sub
Private Sub mnuSched_Click() frmEventScheduler.Show vbModal End Sub
Private Sub mnuScheduledList_Click() ' Open the commands for this report deContacts.ScheduledReport deContacts.EventScheduler rptScheduled.Show vbModal End Sub
Private Sub mnuWCascade_Click() ' Cascade child forms. frmMain.Arrange vbCascade End Sub
Private Sub mnuWTileH_Click() ' Tile child forms (horizontal). frmMain.Arrange vbTileHorizontal End Sub
Private Sub mnuWArrange_Click() ' Arrange all child form icons. frmMain.Arrange vbArrangeIcons End Sub
Private Sub mnuWTileV_Click() ' Tile child forms (vertical). frmMain.Arrange vbTileVertical End Sub
Private Sub Timer1_Timer() deContacts.Timer Static ctr As Integer ctr = ctr + 1 Select Case ctr Case 300 ' Check for late events every 5 minutes If mnu5min.Enabled = True Then ' Call subprocedure EventReminder ctr = 0 End If Case 900 ' 15 minutes If mnu15min.Enabled = True Then EventReminder ctr = 0 End If Case 1800 ' 30 minutes If mnu30min.Enabled = True Then EventReminder ctr = 0 End If Case 3600 ' 60 minutes If mnu60min.Enabled = True Then EventReminder ctr = 0 End If End Select deContacts.rsTimer.Close End Sub
Private Sub EventReminder() ' Searches for any past events Dim varBookmark As Variant With deContacts.rsTimer ' Check to see if the recordset is empty If .BOF And .EOF Then Exit Sub End If ' Move to the beginning of the recordset If .BOF = False Then .MoveFirst End If While Not .EOF ' Check records for overdue scheduled events If .Fields("ScheduledDate") = Date And .Fields("ScheduledTime").Value < Time() Then frmReminder.Show vbModal ElseIf .Fields("ScheduledDate") < Date Then frmReminder.Show vbModal End If If .RecordCount = 0 Then Exit Sub .MoveNext Wend End With End Sub
Next Page - Contact Maintenance

Jump to:
Contact Info  |   Event Scheduler  |   Completed Events  |   Event Reminder

Go to top