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