Cuando se realiza seguimiento al calendario de Outlook y se analiza para ver en qué se está invirtiendo el tiempo, las citas que son recurrentes no son tomadas en cuenta en los cálculos.
Para convertir una instancia de una cita recurrente en una no recurrente y superar este problema, se puede copiar este código en un módulo de Outlook VBA y asignarlo a un botón en la cinta de opciones de citas recurrentes.
Adaptado del código de Diane Poremsky
http://www.slipstick.com/developer/copy-recurring-appointments-meetings-series/
Sub ConvertRecurring()
Dim CalFolder As Outlook.MAPIFolder
Dim CalItems As Outlook.Items
Dim ResItems As Outlook.Items
Dim sFilter, strSubject As String
Dim iNumRestricted As Integer
Dim newAppt As Object
Dim recAppt As Object
' Use the selected calendar folder
Set CalFolder = Application.ActiveExplorer.CurrentFolder
Set recAppt = Application.ActiveExplorer.Selection.Item(1)
' Validate if it's a recuurring appointment
If recAppt.IsRecurring = False Then
MsgBox "Seleccione una cita recurrente"
Exit Sub
End If
Set newAppt = ActiveExplorer.CurrentFolder.Items.Add(olAppointmentItem)
newAppt.Start = recAppt.Start
newAppt.End = recAppt.End
newAppt.Subject = recAppt.Subject
newAppt.Body = recAppt.Body
newAppt.Location = recAppt.Location
newAppt.Categories = recAppt.Categories
newAppt.ReminderSet = False
' Copies attachments to each appointment.
If recAppt.Attachments.Count > 0 Then
CopyAttachments recAppt, newAppt
End If
newAppt.Save
recAppt.Delete
' Display the actual number of appointments created
MsgBox "Se convirtió la instancia de la cita recurrente"
Set newAppt = Nothing
Set ResItems = Nothing
Set CalItems = Nothing
Set CalFolder = Nothing
End Sub
Sub CopyAttachments(objSourceItem, objTargetItem)
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder
strPath = fldTemp.Path & "\"
For Each objAtt In objSourceItem.Attachments
strFile = strPath & objAtt.FileName
objAtt.SaveAsFile strFile
objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
fso.DeleteFile strFile
Next
Set fldTemp = Nothing
Set fso = Nothing
End Sub