Copy my Appointment to Public Calender

[Kevin]

Hi,

I am trying to do the following:
When creating an appointment in my Private Calendar, Ask if to copy
the Appointment to a Public Calendar.
If so then create an appointment copying specific fields across.
I also want to replace NAME with the person who's appointment is being
copied

Below is my code which is not doing the expected. Any help?

Thanks and regards,
Kevin

Function Item_Close()
Dim objFolder
Dim objItem
Dim aFolders
Dim fldr
Dim i
Dim objNS
Dim FolderPath
Dim strFolderPath

ret = MsgBox("Do you want to publish this information to the public
calander", vbYesNo, "Publish to Public Calander")
If ret = vbYes Then
MsgBox "Yes was selected - Start"

On Error Resume Next
FolderPath = "Public Folders/All Public Folders/_All UK Folders/UK
Public Calendar"
strFolderPath = Replace(FolderPath, "/", "\")
aFolders = Split(FolderPath, "\")
Set objNS = Application.GetNamespace("MAPI")
Set fldr = objNS.Folders(aFolders(0))
For i = 1 To UBound(aFolders)
Set fldr = fldr.Folders(aFolders(i))
'check for errors
If Err <> 0 Then Exit For
Next
Set objFolder = fldr
Set objNS = Nothing
Set objItem = objFolder.Items.Add
With objItem
.Subject = "NAME" & " – " & Item.Subject
.Start = Item.Start
.end = Item.End
Set objReqRecip = .Recipients.Add("(e-mail address removed)")
Set objOptRecip = .Recipients.Add("(e-mail address removed)")
objOptRecip.Type = olOptional
.Save
.Display
End With
MsgBox "Yes was selected - End"
ElseIf ret = vbNo Then
MsgBox "No was selected"
End If

End Function

 

[Sue Mosher [MVP]]

I would comment out the On Error Resume Next statement and step through the code to see if particular statements are encountering errors.
--
Sue Mosher, Outlook MVP
Outlook and Exchange solutions at http://www.slipstick.com
Author of
Microsoft Outlook Programming: Jumpstart
for Administrators, Power Users, and Developers