'--------------------------------------------------------------------
' Author   : Patrick Wood http://gainingaccess.net
'          : You may use this code as part of your applications or
'          : in a collection as long as you leave this header intact
'          : and include it with the code
'--------------------------------------------------------------------
'
Private Sub Form_Current()
    If Len(Me.txtDateSelection & vbNullString) = 0 Then
        Me.lblStartInfo.Visible = True
    Else
        Me.lblStartInfo.Visible = False
    End If
End Sub

'--------------------------------------------------------------------
' Author   : Patrick Wood http://gainingaccess.net
'          : You may use this code as part of your applications or
'          : in a collection as long as you leave this header intact
'          : and include it with the code
'--------------------------------------------------------------------
'
Private Sub btnClearAll_Click()
' Clear all controls on the Form
    Me.txtDateSelection = vbNullString
    Me.txtOneDate = vbNullString
    Me.txtStartDate = vbNullString
    Me.txtEndDate = vbNullString
    Me.cboDateRanges = vbNullString
    Me.tglSelectAll = False
    Me.lstAppointments.RowSource = vbNullString
    Me.lstAppointments.Requery
    Me.lblStartInfo.Visible = False
    Me.chkBusiness = False
    Me.chkHolidays = False
    Me.chkOther = False
    Me.chkPersonal = False

End Sub

'--------------------------------------------------------------------
' Author   : Patrick Wood http://gainingaccess.net
'          : You may use this code as part of your applications or
'          : in a collection as long as you leave this header intact
'          : and include it with the code
'--------------------------------------------------------------------
'
Private Sub cmdLstBoxToOutlook_Click()

    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String
    Dim strWhere As String

    ' This variable will be used to tell us how
    ' many Appointments were added to Outlook
    Dim intCount As Integer

    ' This variable will be used in
    ' Looping through the ListBox
    Dim i As Integer

    ' Use late binding to avoid the "Reference" issue
    Dim olApp As Object 'Outlook.Application
    Dim olAppt As Object 'olAppointmentItem

    If isAppThere("Outlook.Application") = False Then
        ' Outlook is not open, create a new instance
        Set olApp = CreateObject("Outlook.Application")
    Else
        ' Outlook is already open--use this method
        Set olApp = GetObject(, "Outlook.Application")
    End If

    ' Build the first part of a SQL String that will include
    ' all of the Appointments selected in the ListBox
    strSQL = "SELECT tblAppointments.* FROM tblAppointments "

    ' Start the first part of the SQL "WHERE" String
    ' The "WHERE" String will hold the Database Appointment ID
    ' Use the "IN" Predicate to make building the SQL easier
    strWhere = "WHERE tblAppointments.ApptmntID IN("

   ' Run the Loop adding a comma , between the ID numbers
    For i = 0 To Me.lstAppointments.ListCount - 1
        If lstAppointments.Selected(i) Then
            strWhere = strWhere & lstAppointments.Column(0, i) & ", "
        End If
    Next i

    ' Remove the last comma and enclose with a Parenthesis
    strWhere = Left(strWhere, Len(strWhere) - 2) & ");"

    ' Put the whole SQL Statement together
    strSQL = strSQL & strWhere

    ' Set a Reference to the CurrentDb
    Set db = CurrentDb()
    ' Create a Recordset based on strSQL
    Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)

    ' Begin a Loop through the Recordset
    ' Move to the first Record
    rst.MoveFirst
    ' Loop to the End of the Recordset
    Do Until rst.EOF

        ' Create a New Outlook Appointment Item
        ' with each loop through the Recordset
        ' 1 is an olAppointmentItem
        Set olAppt = olApp.CreateItem(1)

        ' Add the data to the Appointment Properties
        With olAppt
            ' Set the Appointment Property Values
            .Start = Nz(rst!ApptDate) & " " & Nz(rst!ApptTime, vbNullString)
            .End = Nz(rst!EndDate) & " " & Nz(rst!EndTime, vbNullString)
            .Duration = Nz(rst!ApptLength, 0)
            .Subject = Nz(rst!Appt)
            .Body = Nz(rst!ApptNotes)
            .Location = Nz(rst!Location)

            If rst!ApptReminder = True Then
                If rst!ApptDate < Now() Then
                    ' Do Nothing no Reminder is needed
                Else
                    If Not IsNull(rst!ReminderMinutes) Then
                        .ReminderOverrideDefault = True
                        .ReminderMinutesBeforeStart = rst!ReminderMinutes
                        .ReminderSet = True
                    End If
                End If
            End If
            ' Add the Category if it exists
            .Categories = Nz(rst!Categories)

            ' Save the Appointment Item Properties
            .Save
        End With

        ' Use intCount to count the Appointments added
        intCount = intCount + 1

        ' Set the AddedToOutlook Database Field to True
        rst.Edit
        rst!AddedToOutlook = -1 ' True
        rst.Update
        rst.MoveNext
    Loop

    ' Release the Outlook object variables.
    Set olAppt = Nothing
    Set olApp = Nothing

    ' Inform the user
    MsgBox intCount & _
      " Appointments were added to Outlook.", _
      vbInformation

End Sub


'--------------------------------------------------------------------
' Author   : Patrick Wood http://gainingaccess.net
'          : You may use this code as part of your applications or
'          : in a collection as long as you leave this header intact
'          : and include it with the code
'--------------------------------------------------------------------
'
Private Sub cmdDeleteSelected_Click()

    Dim db As DAO.Database
    Dim strSQL As String
    Dim strWhere As String
    ' Declare a Variable to use to show
    ' how many records were deleted.
    Dim lngRecDeleted As Long
    Dim i As Integer

    Select Case MsgBox("This action will delete the selected" & _
        " Appointments from your Access Database. " _
        & vbCrLf & "" _
        & vbCrLf & " Are you sure you want to" & _
        " permanently delete these Appointments?" _
        , vbYesNo Or vbExclamation Or vbDefaultButton2, _
        " Delete Database Records?")

        Case vbYes
            ' Let the code continue
        Case vbNo
            MsgBox "Deletion has been cancelled! ", vbInformation
            Exit Sub
    End Select

    ' Build a SQL Statement to Delete the Selected Appointments
    strSQL = "DELETE tblAppointments.* FROM tblAppointments "
    strWhere = "Where tblAppointments.ApptmntID IN("

    ' Loop through the ListBox and gather the data
    For i = 0 To Me.lstAppointments.ListCount - 1
        If lstAppointments.Selected(i) Then
            strWhere = strWhere & lstAppointments.Column(0, i) & ", "
        End If
    Next i

    ' Complete the end of Where Statement
    strWhere = Left(strWhere, Len(strWhere) - 2) & ");"

    ' Put all the SQL together
    strSQL = strSQL & strWhere

    ' Set a Reference to the CurrentDb
    Set db = CurrentDb()

    ' Delete the Selections but Rollback
    ' the deletions if there is an error.
    db.Execute strSQL, dbFailOnError

    ' Inform the user
    lngRecDeleted = db.RecordsAffected
    MsgBox lngRecDeleted & _
        " Appointments were Deleted from the Database.", _
        vbInformation

End Sub