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