VBA: Outlook appointement macro problem
It is a object of selected recurring meeting series.
Please refer below complete code: (It works on some machine but not others
because of problem mentioned in main thread)
Sub ApptWithNotesOnDelete()
Dim olkOldAppt As Outlook.AppointmentItem, _
olkItems As Outlook.Items, _
olkThisSeries As Outlook.Items, _
olkNewAppt As Outlook.AppointmentItem
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set olkOldAppt = Application.ActiveExplorer.Selection(1)
Case "Inspector"
Set olkOldAppt = Application.ActiveInspector.CurrentItem
End Select
Set olkItems = Session.GetDefaultFolder(olFolderCalendar).Items
olkItems.Sort "[Start]"
olkItems.IncludeRecurrences = True
Set olkThisSeries = olkItems.Restrict("[Subject] = '" &
olkOldAppt.Subject & "'")
For Each olkAppt In olkThisSeries
If Date DateValue(olkAppt.Start) Then Exit For
Set olkNewAppt = Application.CreateItem(olAppointmentItem)
With olkNewAppt
.Start = olkAppt.Start
.End = olkAppt.End
.Subject = olkAppt.Subject
.Body = olkAppt.Body
.Location = olkAppt.Location
.ReminderSet = olkAppt.ReminderSet
.BusyStatus = olkAppt.BusyStatus
.Save
End With
Next
olkOldAppt.Delete
Set olkNewAppt = Nothing
Set olkThisSeries = Nothing
Set olkItems = Nothing
Set olkOldAppt = Nothing
End Sub
Thanks,
Paresh
"Michael Bauer [MVP - Outlook]" wrote:
What is olkThisSeries?
--
Best regards
Michael Bauer - MVP Outlook
: Outlook Categories? Category Manager Is Your Tool
: VBOffice Reporter for Data Analysis & Reporting
: http://www.vboffice.net/product.html?pub=6&lang=en
Am Wed, 4 Feb 2009 22:51:30 -0800 schrieb masani paresh:
Hi Friends,
We have almost done with the macro and it is working fine on some
*machines.* We have one question. Could you please help on this and we are
done.
On some machine below portion of code works in strenge manner.
For Each olkAppt In olkThisSeries
MsgBox Date & " " & DateValue(olkAppt.Start)
If Date DateValue(olkAppt.Start) Then Exit Do
Set olkNewAppt = Application.CreateItem(olAppointmentItem)
With olkNewAppt
.Start = olkAppt.Start
.End = olkAppt.End
.Subject = olkAppt.Subject
.Body = olkAppt.Body
.Location = olkAppt.Location
.ReminderSet = olkAppt.ReminderSet
.BusyStatus = olkAppt.BusyStatus
.Save
End With
Next
The olkAppt.Start time returns always the date and time of first meeting
and
hence this loop goes in infinite loop. What could be the reason here? We
also
tried below code but no luck. Please note that it happens only on some
machine while working on another machines.
Do While True
MsgBox Date & " " & DateValue(olkAppt.Start)
If Date DateValue(olkAppt.Start) Then Exit Do
Set olkNewAppt = Application.CreateItem(olAppointmentItem)
With olkNewAppt
.Start = olkAppt.Start
.End = olkAppt.End
.Subject = olkAppt.Subject
.Body = olkAppt.Body
.Location = olkAppt.Location
.ReminderSet = olkAppt.ReminderSet
.BusyStatus = olkAppt.BusyStatus
.Save
End With
Set olkAppt = olkThisSeries.GetNext
Loop
Thanks in advanced
|