How to copy an appointment from a public calendar to personal cale

  • Thread starter Thread starter Tiger
  • Start date Start date
T

Tiger

Hi,

I have little experience with VBA. I have a script that i got from here
which allows me press a button that once pressed it would add the user that
pressed it to the list of required attendees to the existing event.

However i want it to also add the event that was pressed to send the
appointment to the personal calendar.

Bellow is the script that i am using. What and where should i add the
function that i need?

Thank you for you time.

Sub AddRecip()
Dim oAppt As Outlook.AppointmentItem
Dim colRecips As Outlook.Recipients
Dim oRecip As Outlook.Recipient

Set oAppt = Application.ActiveExplorer.Selection.Item(1)
Set colRecips = oAppt.Recipients
Set oRecip = colRecips.Add(Application.GetNamespace("MAPI").CurrentUser)
oRecip.Type = olTo

oAppt.Save
oAppt.Send


Set oRecip = Nothing
Set colRecips = Nothing
Set oAppt = Nothing
End Sub
 
Before you release the item just use its Copy() method to copy it wherever
you want.
 
Ken, Thanks for the help. Though i do have limited knowledge. I have done
this but it will not work can you show me and rectify my problem? I want it
to be copied in the standard personal calendar.

Thanks,

Sub AddRecip()
Dim oAppt As Outlook.AppointmentItem
Dim colRecips As Outlook.Recipients
Dim oRecip As Outlook.Recipient

Set oAppt = Application.ActiveExplorer.Selection.Item(1)
Set colRecips = oAppt.Recipients
Set oRecip = colRecips.Add(Application.GetNamespace("MAPI").CurrentUser)
oRecip.Type = olTo

oAppt.Save
oAppt.Copy ("Calendar")
oAppt.Send


Set oRecip = Nothing
Set colRecips = Nothing
Set oAppt = Nothing
End Sub
 
If you look at the Object Browser for AppointmentItem.Copy() you will see
that it returns an object (a function) and that it accepts no arguments.
Take the return value as another AppointmentItem and then call Move() on
that item using the calendar MAPIFolder object as the argument.

Dim oNewAppt As Outlook.AppointmentItem
Dim oMoved As Outlook.AppointmentItem
Dim oNS As Outlook.NameSpace
Dim oFolder As Outlook.MAPIFolder

Set oNS = Application.GetNameSpace("MAPI")
Set oFolder = oNS.GetDefaultFolder(olFolderCalendar)

' other code

Set oNewAppt = oAppt.Copy()
oNewAppt.Save
Set oMoved = oNewAppt.Move(oFolder)
 
Back
Top