Click to go home

This is the completed events form

Option Explicit

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdUpdate_Click()
    
    Dim varBookmark As Variant
    ' Complete a scheduled event
    If optComplete(0) Then
              
        ' Check to see if the completed time is after the scheduled time
        If dtpCompletedDate.Value = txtScheduledDate.Text And _
            Format(dtpCompletedTime.Value, "hh:mm") > Format(txtScheduledTime.Text, "hh:mm") Then
            ' Update completed events table
            With deContacts.rsCompletedEvents
                .AddNew
                !Comments = txtComments.Text
                !CompletedTime = Format(dtpCompletedTime.Value, "hh:mm")
                !CompletedDate = dtpCompletedDate.Value
                !ContactID = txtContactId.Text
                !ScheduledDate = txtScheduledDate.Text
                !ScheduledTime = txtScheduledTime.Text
                .UpdateBatch
            End With
            With deContacts.rsEventScheduler
                varBookmark = .Bookmark
                .Find "EventCounter = '" & lstScheduledEvents.ItemData(lstScheduledEvents.ListIndex) & "'", 0, _
                adSearchForward, adBookmarkFirst
                If .EOF Or .BOF Then
                    .Bookmark = varBookmark
                    MsgBox "Record Not Found.", vbExclamation, "Record"
                End If
                ' Delete the record from the scheduled events table
                .Delete
                .UpdateBatch
                .MoveNext
                
                On Error Resume Next
                If .EOF = True Then
                     .MoveLast
                     If Err.Number <> 0 Then
                     .Move 0
                     End If
                End If
                   
                MsgBox "The database has been updated.", , "Update"
                PopulateList
            End With
        
        ElseIf dtpCompletedDate.Value > txtScheduledDate.Text Then
            ' Update completed events table
            With deContacts.rsCompletedEvents
                .AddNew
                !Comments = txtComments.Text
                !CompletedTime = Format(dtpCompletedTime.Value, "hh:mm")
                !CompletedDate = dtpCompletedDate.Value
                !ContactID = txtContactId.Text
                !ScheduledDate = txtScheduledDate.Text
                !ScheduledTime = txtScheduledTime.Text
                .UpdateBatch
            End With
            With deContacts.rsEventScheduler
                varBookmark = .Bookmark
                .Find "EventCounter = '" & lstScheduledEvents.ItemData(lstScheduledEvents.ListIndex) & "'", 0, _
                adSearchForward, adBookmarkFirst
                If .EOF Or .BOF Then
                    .Bookmark = varBookmark
                    MsgBox "Record Not Found.", vbExclamation, "Record"
                End If
                ' Delete record from scheduled events table
                .Delete
                .UpdateBatch
                .MoveNext
                
                On Error Resume Next
                If .EOF = True Then
                     .MoveLast
                     If Err.Number <> 0 Then
                     .Move 0
                     End If
                End If

                MsgBox "The database has been updated.", , "Update"
                PopulateList
            End With
            
        ElseIf dtpCompletedDate.Value < txtScheduledDate.Text Then
            MsgBox "Your completed date must be after the scheduled date.", vbExclamation _
            , "Date"
            dtpCompletedDate.SetFocus
        Else
            MsgBox "Your completed time must be after the scheduled time.", vbExclamation _
            , "Time"
            dtpCompletedTime.SetFocus
        End If
        Exit Sub
    End If
    
    ' Complete an Unscheduled Event
    If optComplete(1) Then
      ' Check that all of the controls contain data
        If Trim(txtLastName.Text) = "" Then
            MsgBox "You must highlight a name from the list.", vbExclamation _
            , "Name"
            txtLastName.SetFocus
            Exit Sub
        ElseIf Trim(txtFirstName.Text) = "" Then
            MsgBox "You must select a name from the list.", vbExclamation _
            , "Name"
            txtFirstName.SetFocus
            Exit Sub
        ElseIf Trim(txtContactId.Text) = "" Then
            MsgBox "You must select a name from the list.", vbExclamation _
            , "Name"
        End If
         With deContacts.rsCompletedEvents
                .AddNew
                !Comments = txtComments.Text
                !CompletedTime = Format(dtpCompletedTime.Value, "hh:mm")
                !CompletedDate = dtpCompletedDate.Value
                !ContactID = txtContactId.Text
                !ScheduledDate = txtScheduledDate.Text
                !ScheduledTime = txtScheduledTime.Text
                
                .UpdateBatch
            End With
        MsgBox "The database has been updated.", , "Update"
        PopulateList
        
    End If

End Sub

Private Sub Form_Activate()
    PopulateList
    
End Sub

Private Sub Form_Load()
        
    ' Clear the data in the text boxes
    txtComments.Text = " "
    txtContactId.Text = ""
    txtScheduledDate.Text = ""
    txtScheduledTime.Text = ""
    txtFirstName.Text = ""
    txtLastName.Text = ""
         
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ' Close the unbound record sets
    deContacts.rsNames.Close
    deContacts.rsEventScheduler.Close
    deContacts.rsCompletedEvents.Close
    
End Sub

Private Sub lstNames2_Click()
    Dim varBookmark As Variant
    txtContactId.Text = lstNames2.ItemData(lstNames2.ListIndex)
    ' Move to the beginning of the recordset
    If deContacts.rsNames.BOF = False Then
        deContacts.rsNames.MoveFirst
    End If
    
    ' Search to find names associated with Contact ID
    With deContacts.rsNames
        varBookmark = .Bookmark
        .Find "ContactID = '" & txtContactId.Text & "'", 0, _
        adSearchForward, adBookmarkFirst
        If .EOF Or .BOF Then
            .Bookmark = varBookmark
            MsgBox "Record Not Found.", vbExclamation, "Record"
        End If
    
        ' Print names in textboxes
        txtFirstName.Text = .Fields("FirstName")
        txtLastName.Text = .Fields("LastName")
    End With
        
    txtScheduledDate.Text = Date
    txtScheduledTime.Text = Time
    dtpCompletedDate.Value = Date
    dtpCompletedTime.Value = Time
    
    cmdUpdate.Enabled = True
           
End Sub

Private Sub txtFirstName_Click()
     If optComplete(0).Value = True And cmdUpdate.Enabled = False Then
        ' Force the user to highlight an event on the list
        MsgBox "Please select an event from the list", vbExclamation, _
        "Event"
    ElseIf optComplete(1).Value = True And cmdUpdate.Enabled = False Then
        ' Force the user to highlight an event on the list
        MsgBox "Please select a name from the list", vbExclamation, _
        "Event"
    End If
End Sub

Private Sub lstScheduledEvents_Click()
    Dim intSEventCounter As Integer
    Dim varBookmark As Variant
    
    intSEventCounter = lstScheduledEvents.ItemData(lstScheduledEvents.ListIndex)
         
    ' Move to the beginning of the recordset
    If deContacts.rsEventScheduler.BOF = False Then
        deContacts.rsEventScheduler.MoveFirst
    End If
    
    ' Search to find scheduled event information
    With deContacts.rsEventScheduler
        varBookmark = .Bookmark
        .Find "EventCounter = '" & intSEventCounter & "'", 0, _
        adSearchForward, adBookmarkFirst
        If .EOF Or .BOF Then
            .Bookmark = varBookmark
            MsgBox "Record Not Found.", vbExclamation, "Record"
        End If
               
        txtScheduledDate.Text = .Fields("ScheduledDate").Value
        txtScheduledTime.Text = .Fields("ScheduledTime").Value
        dtpCompletedDate.Value = Date
        dtpCompletedTime.Value = Time
        txtContactId.Text = .Fields("ContactID").Value
            
    End With
    
    ' Move to the beginning of the recordset
    If deContacts.rsNames.BOF = False Then
        deContacts.rsNames.MoveFirst
    End If
    
    ' Search to find names associated with Contact ID
    With deContacts.rsNames
        varBookmark = .Bookmark
        .Find "ContactID = '" & txtContactId.Text & "'", 0, _
        adSearchForward, adBookmarkFirst
        If .EOF Or .BOF Then
            .Bookmark = varBookmark
            MsgBox "Record Not Found.", vbExclamation, "Record"
        End If
        txtFirstName.Text = .Fields("FirstName")
        txtLastName.Text = .Fields("LastName")
        
    End With
    
    cmdUpdate.Enabled = True
    
End Sub

Private Sub optComplete_Click(Index As Integer)
    Select Case Index
        ' If there are no scheduled events
        Case 0
          If deContacts.rsEventScheduler.BOF And deContacts.rsEventScheduler.EOF Then
            Unload Me
        End If
        
        ' If a non-scheduled event
        Case 1
                        
            lstScheduledEvents.Enabled = False
            optComplete(0).Enabled = False
            'show the list of contact names
            lstScheduledEvents.Visible = False
            lstNames2.Visible = True
            dtpCompletedDate.Enabled = False
            dtpCompletedTime.Enabled = False
            
            
        ' Check to see if the recordset is empty
        If deContacts.rsNames.BOF And deContacts.rsNames.EOF Then
            MsgBox "There are no contacts in the database", , "Contacts"
            Exit Sub
        End If
        
        ' Move to the beginning of the recordset
        If deContacts.rsNames.BOF = False Then
            deContacts.rsNames.MoveFirst
        End If
    
        ' Show the contact names in the list box
        With deContacts.rsNames
        While Not .EOF
            ' Add a name to the list
            lstNames2.AddItem .Fields("LastName").Value & ", " & _
            .Fields("FirstName").Value
            lstNames2.ItemData(lstNames2.NewIndex) = .Fields("ContactID")
            .MoveNext
        Wend
        End With
            
    End Select
End Sub

Private Sub txtContactId_Click()
    If optComplete(0).Value = True And cmdUpdate.Enabled = False Then
        ' Force the user to highlight an event on the list
        MsgBox "Please select an event from the list", vbExclamation, _
        "Event"
    ElseIf optComplete(1).Value = True And cmdUpdate.Enabled = False Then
        ' Force the user to highlight an event on the list
        MsgBox "Please select a name from the list", vbExclamation, _
        "Event"
    End If
End Sub

Private Sub txtLastName_Click()
    If optComplete(0).Value = True And cmdUpdate.Enabled = False Then
        ' Force the user to highlight an event on the list
        MsgBox "Please select an event from the list", vbExclamation, _
        "Event"
    ElseIf optComplete(1).Value = True And cmdUpdate.Enabled = False Then
        ' Force the user to highlight an event on the list
        MsgBox "Please select a name from the list", vbExclamation, _
        "Event"
    End If
End Sub

Private Sub txtScheduledDate_Click()
    If optComplete(0).Value = True And cmdUpdate.Enabled = False Then
        ' Force the user to highlight an event on the list
        MsgBox "Please select an event from the list", vbExclamation, _
        "Event"
    ElseIf optComplete(1).Value = True And cmdUpdate.Enabled = False Then
        ' Force the user to highlight an event on the list
        MsgBox "Please select a name from the list", vbExclamation, _
        "Event"
    End If
End Sub

Private Sub txtScheduledTime_Click()
    If optComplete(0).Value = True And cmdUpdate.Enabled = False Then
        ' Force the user to highlight an event on the list
        MsgBox "Please select an event on the list", vbExclamation, _
        "Event"
    ElseIf optComplete(1).Value = True And cmdUpdate.Enabled = False Then
        ' Force the user to highlight an event on the list
        MsgBox "Please select a name from the list", vbExclamation, _
        "Event"
    End If
End Sub

Private Sub PopulateList()

    On Error GoTo ErrorHandler
    deContacts.CompletedEvents
    deContacts.EventScheduler
    deContacts.Names
    On Error GoTo 0
    
    If optComplete(1).Value = True Then Exit Sub
    
    Dim intCID As Integer 'stored Contact ID
    Dim varBookmark As Variant
    
    lstScheduledEvents.Clear
    txtComments.Text = " "
    txtContactId.Text = ""
    txtScheduledDate.Text = ""
    txtScheduledTime.Text = ""
    txtFirstName.Text = ""
    txtLastName.Text = ""
    cmdUpdate.Enabled = False
        
    ' Check to see if the recordset is empty
    If deContacts.rsEventScheduler.BOF And deContacts.rsEventScheduler.EOF And optComplete(0).Value = True Then
        MsgBox "There are no events scheduled.", , "Events"
        
        Exit Sub
    End If
        
    ' Move to the beginning of the recordset
    If deContacts.rsEventScheduler.BOF = False Then
        deContacts.rsEventScheduler.MoveFirst
    End If
    
    ' Show the contact names in the list box
    With deContacts.rsEventScheduler
    While Not .EOF
        intCID = .Fields("ContactID")
        ' Search to find name that belongs to contact ID
        With deContacts.rsNames
            varBookmark = .Bookmark
            .Find "ContactID = '" & intCID & "'", 0, _
            adSearchForward, adBookmarkFirst
            If .EOF Or .BOF Then
                .Bookmark = varBookmark
                MsgBox "Record Not Found.", vbExclamation, "Record"
            End If
        End With
        
        ' Populate listbox
        lstScheduledEvents.AddItem .Fields("ScheduledDate").Value & "   " & _
        .Fields("ScheduledTime").Value & "   " & deContacts.rsNames.Fields("LastName").Value & _
        ", " & deContacts.rsNames.Fields("FirstName")
        lstScheduledEvents.ItemData(lstScheduledEvents.NewIndex) = .Fields("EventCounter").Value
        .MoveNext
    Wend
    End With
    Exit Sub
ErrorHandler:
    deContacts.rsNames.Close
    deContacts.rsEventScheduler.Close
    deContacts.rsCompletedEvents.Close
    Resume
End Sub