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