I have constructed the Function below to handle sending appointments to Outlook calendars on Local machine or Exchange Server depending on my clients settings.
As you can see olExchFolder is either yes or no and use the routines as noted.
The code I have gleaned from many different sources and cobbled together.
The first part works perfectly sending to local folder. olExchFolder = False
But the second part of the If statement olExchFolder = True raises the error 440 Outlook does not recognize one or more names.
Can anyone see an obvious fault in the code after the 'Else' statement that is stopping it working or am I not addressing the Outlook folder correctly?
Any help would be much appreciated.
Andy.
Expand|Select|Wrap|Line Numbers
- Public Function SendAppointmentToOutlook( _
- olExchFolder As Boolean, _
- olCalendarName As String, _
- olStartDate As String, _
- olEndDate As String, _
- olLocation As String, _
- olSubject As String, _
- olBody As String, _
- Optional olDuration As Long = 0, _
- Optional olAllDayEvent As Boolean = True, _
- Optional olReminderMinutes As Long = 90, _
- Optional olReminderSet As Boolean = False)
- Dim outobj As Object ' *The Outlook.Application
- Dim outappt As Object ' *The Outlook.AppointmentItem
- Dim olFolder As Object ' *The Required Folder/Calendar
- Dim Namespace As Object
- Dim objOutlook As Object
- Dim Recipient As Outlook.Recipient
- If olExchFolder = False Then ' *Calendars are sub Calendars in My Calendars Folder on Local machine
- Set outobj = CreateObject("outlook.application")
- Set olFolder = outobj.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Parent.Folders(olCalendarName)
- 'Set olFolder = outobj.GetNamespace("MAPI").pickFolder ** Calls MAPI Dialog to choose Folder
- Set outappt = olFolder.Items.Add
- Else ' *Calendars are in Exchange Folder
- Set objOutlook = New Outlook.Application
- Set Namespace = objOutlook.GetNamespace("MAPI")
- Set Recipient = Namespace.CreateRecipient(olCalendarName)
- Set outappt = Namespace.GetSharedDefaultFolder(Recipient, olFolderCalendar).Items.Add
- End If
- With outappt
- .Start = olStartDate
- .End = olEndDate
- .Duration = olDuration
- .AllDayEvent = olAllDayEvent
- .Location = olLocation
- .Subject = olSubject
- .Body = olBody
- .ReminderMinutesBeforeStart = olReminderMinutes
- .ReminderSet = olReminderSet
- .Save
- End With
- ' *Release the Outlook object variables.
- Set outobj = Nothing
- Set outappt = Nothing
- Set olFolder = Nothing
- Set Namespace = Nothing
- Set Recipient = Nothing
- Set objOutlook = Nothing
- End Function