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