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