[AccessD] Picking Alternate Calendar

Max Wanadoo max.wanadoo at gmail.com
Fri Mar 12 05:12:02 CST 2010


Sorry,
Think I sent the wrong code in my  last  posting.  Try this

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 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 ofCalendar = ofMyOutlook.Folders(strCalendarName)    ' this is the
FOUND  name
    With ofCalendar
        Set myItem = ofCalendar.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/12/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 




More information about the AccessD mailing list