[AccessD] Picking Alternate Calendar

Rocky:

Try this code below

Max

Private Sub sDeleteCalEvents()
    Dim strDateFrom As String, strDateTo As String
    strDateFrom = "01/01/2010"    ' mm/dd/yyyy
    strDateTo = "12/31/2010"    ' mm/dd/yyyy
    Dim ol As Outlook.Application
    Dim onMAPI As NameSpace
    Dim ofMyOutlook As MAPIFolder
    Dim ofFolder As MAPIFolder
    Dim ofCalendar As MAPIFolder
    Dim myItem As Object
    Dim myCalendar As Object
    Dim strCalendarName As String
    ' this is the variable which can be passed in as the name of the  new
(non-default calendar)
    ' because it is non-system calendar we cannot use ol.creatitem() but
have to use .items.add
    strCalendarName = "My Calendar"
    Set ol = New Outlook.Application
    Dim ifor As Integer
    Set onMAPI = ol.GetNamespace("MAPI")
    On Error Resume Next
    Set ofMyOutlook = onMAPI.Folders("Personal Folders")    '  but I renamed
mine
    If Err.Number <> 0 Then
        MsgBox "The Outlook 'Personal Folder' cannot be found. Have you
renamed it to something else perhaps?."
        Exit Sub
    End If
    Set ofCalendar = ofMyOutlook.Folders("Calendar")    ' this is the
normal  name
    ' go though the folders inside the calendar folder and see if we can
find the user-defined calendar
    For ifor = 1 To ofCalendar.Folders.Count
        ' Debug.Print ofCalendar.Folders(ifor), ifor
        If ofCalendar.Folders(ifor) = strCalendarName Then
            Set myCalendar = ofCalendar.Folders(ifor)    ' Got it
            ifor = ofCalendar.Folders.Count    ' jump  out
        End If
    Next ifor

    Debug.Print myCalendar.Items.Count

    For ifor = myCalendar.Items.Count To 1 Step -1 ' work backwards
        Debug.Print Format(myCalendar.Items(ifor).Start, "mm/dd/yyyy"), '
trailing comma
        If Format(myCalendar.Items(ifor).Start, "mm/dd/yyyy") >= strDateFrom
And Format(myCalendar.Items(ifor).Start, "mm/dd/yyyy") <= strDateTo Then
            Debug.Print "Deleted"
            myCalendar.Items(ifor).Delete
        Else
            Debug.Print "Not deleted"
        End If
    Next ifor
End Sub

Private Sub sCalendar()
    Dim ol As Outlook.Application
    Dim onMAPI As NameSpace
    Dim ofMyOutlook As MAPIFolder
    Dim ofFolder As MAPIFolder
    Dim ofCalendar As MAPIFolder
    Dim myItem As Object
    Dim myCalendar As Object
    Dim strCalendarName As String
    Dim myRequiredAttendee As Outlook.Recipient
    Dim myoptionalAttendee As Outlook.Recipient
    Dim myResourceAttendee As Outlook.Recipient
    ' this is the variable which can be passed in as the name of the  new
(non-default calendar)
    ' because it is non-system calendar we cannot use ol.creatitem() but
have to use .items.add
    strCalendarName = "My Calendar"
    Set ol = New Outlook.Application
    Dim ifor As Integer
    Set onMAPI = ol.GetNamespace("MAPI")
    On Error Resume Next
    Set ofMyOutlook = onMAPI.Folders("Personal Folders")    '  but I renamed
mine
    If Err.Number <> 0 Then
        MsgBox "The Outlook 'Personal Folder' cannot be found. Have you
renamed it to something else perhaps?."
        Exit Sub
    End If
    Set ofCalendar = ofMyOutlook.Folders("Calendar")    ' this is the
normal  name
    ' go though the folders inside the calendar folder and see if we can
find the user-defined calendar
    For ifor = 1 To ofCalendar.Folders.Count
        ' Debug.Print ofCalendar.Folders(ifor), ifor
        If ofCalendar.Folders(ifor) = strCalendarName Then
            Set myCalendar = ofCalendar.Folders(ifor)    ' Got it
            ifor = ofCalendar.Folders.Count    ' jump  out
        End If
    Next ifor
    If ifor > ofCalendar.Folders.Count + 1 Or ofCalendar.Folders.Count = 0
Then
        MsgBox "The user caledar (" & strCalendarName & ") does not appear
as a sub folder of Calendar.  Press OK and I will created it for you."
        Set ofFolder = onMAPI.GetDefaultFolder(olFolderCalendar)
        Set myCalendar = ofFolder.Folders.Add(strCalendarName)
    End If
    ' might need  ClickYes installed if you require to send without user
viewing first.
    With myCalendar
        Set myItem = myCalendar.Items.Add    '
ol.CreateItem(olAppointmentItem)
        With myItem
            .MeetingStatus = olMeeting
            .Subject = "Meeting Tomorrow BoardRoom - test from Max at
AccessD"
            .Location = "Conference Room No. 33"
            .Start = #3/10/2010 2:30:00 PM#     ' month/day/year - change as
required.
            .Duration = 90
            '
            Set myRequiredAttendee = myItem.Recipients.Add("
rockysmolin at bchacc.com")
            myRequiredAttendee.Type = olRequired
            Set myoptionalAttendee = myItem.Recipients.Add("
rockysmolin at bchacc.com")
            myoptionalAttendee.Type = olOptional
            Set myResourceAttendee = myItem.Recipients.Add("
rockysmolin at bchacc.com")
            myResourceAttendee.Type = olResource
            '.Display
            myItem.Send
        End With
    End With
End Sub