MartinDurham
05-12-2016, 05:34 AM
Hi Folks
We have a calendar that is used to record a service schedule, the appointment is added initially with a preset occurence and a category labelled as 'due'.
When an appointment has passed we need to be able to set that instance of the appointment to 'Complete' however, outlook will not let us change the category of a single appointment belonging to a series.
So instead I thought I would copy that instance of the appointment, change the category and then delete the original instance.
I managed to find the following code to get me going (my thanks to the original author)
Sub OpenAppointmentCopy()
'=================================================================
'Description: Outlook macro to create a new appointment with
' specific details of the currently selected
' appointment and show it in a new window.
'
' author : Robert Sparnaaij
' version: 1.0
' website:
'=================================================================
Dim objOL As Outlook.Application
Dim objSelection As Outlook.Selection
Dim objItem As Object
Set objOL = Outlook.Application
'Get the selected item
Select Case TypeName(objOL.ActiveWindow)
Case "Explorer"
Set objSelection = objOL.ActiveExplorer.Selection
If objSelection.count > 0 Then
Set objItem = objSelection.Item(1)
Else
Result = MsgBox("No item selected. " & _
"Please make a selection first.", _
vbCritical, "OpenAppointmentCopy")
Exit Sub
End If
Case "Inspector"
Set objItem = objOL.ActiveInspector.CurrentItem
Case Else
Result = MsgBox("Unsupported Window type." & _
vbNewLine & "Please make a selection" & _
"in the Calendar or open an item first.", _
vbCritical, "OpenAppointmentCopy")
Exit Sub
End Select
Dim olAppt As Outlook.AppointmentItem
Dim olApptCopy As Outlook.AppointmentItem
Set olApptCopy = Outlook.CreateItem(olAppointmentItem)
'Copy the desired details to a new appointment item
If objItem.Class = olAppointment Then
Set olAppt = objItem
With olApptCopy
.Subject = olAppt.Subject
.Location = olAppt.Location
.Body = olAppt.Body
.Categories = olAppt.Categories
.AllDayEvent = olAppt.AllDayEvent
End With
'Display the copy
olApptCopy.Display
'Selected item isn't an appointment item
Else
Result = MsgBox("No appointment item selected. " & _
"Please make a selection first.", _
vbCritical, "OpenAppointmentCopy")
Exit Sub
End If
'Clean up
Set objOL = Nothing
Set objItem = Nothing
Set olAppt = Nothing
Set olApptCopy = Nothing
End Sub
The above code works great however, it copies the appointment to my own personal calendar and not the shared calendar that I am working on, is there a way around this, and can the original appointment instance then be deleted afterwards by the same VBA?
Thanks in advance
Martin
We have a calendar that is used to record a service schedule, the appointment is added initially with a preset occurence and a category labelled as 'due'.
When an appointment has passed we need to be able to set that instance of the appointment to 'Complete' however, outlook will not let us change the category of a single appointment belonging to a series.
So instead I thought I would copy that instance of the appointment, change the category and then delete the original instance.
I managed to find the following code to get me going (my thanks to the original author)
Sub OpenAppointmentCopy()
'=================================================================
'Description: Outlook macro to create a new appointment with
' specific details of the currently selected
' appointment and show it in a new window.
'
' author : Robert Sparnaaij
' version: 1.0
' website:
'=================================================================
Dim objOL As Outlook.Application
Dim objSelection As Outlook.Selection
Dim objItem As Object
Set objOL = Outlook.Application
'Get the selected item
Select Case TypeName(objOL.ActiveWindow)
Case "Explorer"
Set objSelection = objOL.ActiveExplorer.Selection
If objSelection.count > 0 Then
Set objItem = objSelection.Item(1)
Else
Result = MsgBox("No item selected. " & _
"Please make a selection first.", _
vbCritical, "OpenAppointmentCopy")
Exit Sub
End If
Case "Inspector"
Set objItem = objOL.ActiveInspector.CurrentItem
Case Else
Result = MsgBox("Unsupported Window type." & _
vbNewLine & "Please make a selection" & _
"in the Calendar or open an item first.", _
vbCritical, "OpenAppointmentCopy")
Exit Sub
End Select
Dim olAppt As Outlook.AppointmentItem
Dim olApptCopy As Outlook.AppointmentItem
Set olApptCopy = Outlook.CreateItem(olAppointmentItem)
'Copy the desired details to a new appointment item
If objItem.Class = olAppointment Then
Set olAppt = objItem
With olApptCopy
.Subject = olAppt.Subject
.Location = olAppt.Location
.Body = olAppt.Body
.Categories = olAppt.Categories
.AllDayEvent = olAppt.AllDayEvent
End With
'Display the copy
olApptCopy.Display
'Selected item isn't an appointment item
Else
Result = MsgBox("No appointment item selected. " & _
"Please make a selection first.", _
vbCritical, "OpenAppointmentCopy")
Exit Sub
End If
'Clean up
Set objOL = Nothing
Set objItem = Nothing
Set olAppt = Nothing
Set olApptCopy = Nothing
End Sub
The above code works great however, it copies the appointment to my own personal calendar and not the shared calendar that I am working on, is there a way around this, and can the original appointment instance then be deleted afterwards by the same VBA?
Thanks in advance
Martin