[AccessD] Picking Alternate Calendar

Rocky:


Here  is the code:

Max


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")
    Set ofMyOutlook = onMAPI.Folders("Max Outlook") ' normally "Personal
Folders" but I renamed mine
    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 Then
        MsgBox "Check the name of the user caledar as it does not appear as
a sub folder of Calendar"
        Exit Sub
    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 1: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