[AccessD] Picking Alternate Calendar

It keeps posting the wrong code. Must be my buffer.

Here  it is once again - sorry about all that. I had turned the on error off
so that I could  see it  going through without a problem.


Max

Private Sub sCalendar()
    Dim ol As Outlook.Application
    Dim onMAPI As NameSpace
    Dim ofFolder As MAPIFolder
    Dim ofCalendar As MAPIFolder
    Dim myCalendar As MAPIFolder
    Dim myItem As Object
    Dim strCalendarName As String
    Dim myRequiredAttendee As Outlook.Recipient
    Dim myoptionalAttendee As Outlook.Recipient
    Dim myResourceAttendee As Outlook.Recipient
    Dim ifor As Integer

    Set ol = New Outlook.Application
    Set onMAPI = ol.GetNamespace("MAPI")
    'On Error Resume Next

    'Debug.Print onMAPI.Class
    'Debug.Print onMAPI.CurrentUser ' might be useful to get this then you
can personlise your responses to him
    ' eg.Hey Rocky,your  appointment has been made - next  time  use your
cellphone.
    'Debug.Print onMAPI.GetDefaultFolder(olFolderCalendar)

    Set ofCalendar = onMAPI.GetDefaultFolder(olFolderCalendar)
    For Each ofFolder In ofCalendar.Folders
        ' this assumes there is only ONE sub calendar but if there are more
than one,
        ' you will need to pop them up and ask which one or define it in
some way.
        strCalendarName = ofFolder.Name: Debug.Print ofFolder.Name
    Next ofFolder

    Set myCalendar = ofCalendar.Folders(strCalendarName)    ' this is the
FOUND  name
    ' if you want to change the sub-folder name.
    'myCalendar.Name = "Something Else"
    
    With myCalendar
        Set myItem = myCalendar.Items.Add    '
ol.CreateItem(olAppointmentItem)
        With myItem
            .MeetingStatus = olMeeting
            .Subject = "Meeting Sunday - test from Max at AccessD"
            .Location = "Conference Room No. 33"
            .Start = #3/14/2010 10:30:00 AM#     ' 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
            .Body = ""
            .Display
            'myItem.Send
        End With
    End With
End Sub