How do I remove duplicate appointments in outlook?

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

HH - 22 Mar 2005 15:01 GMT

I have synchronised my pda with outlook after my computer had been repaired
and for some reason it has duplicated most, but not all, of my appointments.
I can see a remove duplicates instruction for contacts, but not for
calendars. How can I do this?

Reply to this Message

Oliver Vukovics - 22 Mar 2005 16:55 GMT

Hi HH,

have a look on this sites for duplicate contacts remover:
http://www.slipstick.com/addins/contacts.htm#dupes

--
Oliver Vukovics
Share Outlook without Exchange: Public ShareFolder
Notebook Synchronisation for Outlook: Public SyncTool
http://www.publicshareware.com

>I have synchronised my pda with outlook after my computer had been repaired
> and for some reason it has duplicated most, but not all, of my
> appointments.
> I can see a remove duplicates instruction for contacts, but not for
> calendars. How can I do this?

Reply to this Message

Temsi - 24 Mar 2005 00:20 GMT

Hello!
I Have made a VBA Script to remove duplicate appointments in Outlook:

Public Sub Delete_Duplicate_Appointments()
' Delete duplicate appointments

Const olFolderCalendar = 9

Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderCalendar)
Set myItems = myFolder.Items

'Sort the calendar database
Dim strTri
strTri = ""
strTri = strTri & "[Start]"
strTri = strTri & "[End]"
strTri = strTri & "[Subject]"
strTri = strTri & "[Body]"
strTri = strTri & "[AllDayEvent]"
strTri = strTri & "[Sensitivity]"

myItems.Sort strTri

'Delete successive equal appointments

Dim lastStr, Str, nbrDelete
lastStr = ""

nbrDelete = 0
For Each Item In myItems

Str = ""
Str = Str & vbCrLf & Item.Start
Str = Str & vbCrLf & Item.End
Str = Str & vbCrLf & Item.Subject
Str = Str & vbCrLf & Item.Body
Str = Str & vbCrLf & Item.AllDayEvent
Str = Str & vbCrLf & Item.Sensitivity

Str = Replace(Str, vbCrLf & vbCrLf, vbCrLf)
Str = Replace(Str, vbCrLf & vbCrLf, vbCrLf)
Str = Replace(Str, vbCrLf & vbCrLf, vbCrLf)
Str = Replace(Str, vbCrLf & vbCrLf, vbCrLf)
Str = Replace(Str, vbCrLf & vbCrLf, vbCrLf)

If Str = lastStr Then
Item.Delete
nbrDelete = nbrDelete + 1
End If
lastStr = Str
Next

MsgBox "Nbr appointments deleted : " & nbrDelete

End Sub

Good luck!

Reply to this Message