I have a macro that I run periodically on a particular contacts folder to
change all the Last Names of the contacts in that folder to uppercase. The
code, shown below, seems to work fine, except that, every time I run it, it
creates an extra shortcut in my calendar for each of the contacts' birthdays.
I now have four shortcuts for each of about 200 contacts' birthdays.

Can anyone suggest
(a) How to modify my code to stop this happening in future
(b) A new macro to remove the redundant shortcuts in my calendar.

I am using Outlook 2003 (fully updated) on Windows XP Professional (fully
updated)

TIA Anthony

Sub PutLastNameInCaps()
'For phone contacts folder so they are easier to read on my phone

Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderContacts)
Set myNewFolder = myFolder.Folders("Phone contacts")

For Each mycontact In myNewFolder.Items
MyNewName = UCase(mycontact.LastName)
mycontact.LastName = MyNewName
mycontact.Save
Next mycontact

End Sub