Birthdays in calendar

[Twotone]

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

 

[Peter Marchert]

This "feature" is only supported in Outlook Version 2003.

You can try to use the following code to remove the birthday entry:

Public Sub RemoveBirthDay(ByVal strBirthDay As String, ByVal strName As
String)

Dim objCalendar As Outlook.AppointmentItem
Dim strFind As String

strFind = "[Subject] = " & strName & Asc(39) & "s " &
"""Birthday"""""
Set objCalendar =
Outlook.Session.GetDefaultFolder(olFolderCalendar).Items.Find(strFind)

If Not objCalendar Is Nothing Then
If objCalendar.Start = strBirthDay Then objCalendar.Delete
End If

End Sub

If you have anniversaries in your contact you need to delete these too.

Best Regards
Peter

 

[Peter Marchert]

It doesn`t matter - lot of people never reply, thanks.

Peter

Thanks, Peter. Sorry for delay in saying so.

Happy new year, Anthony

This "feature" is only supported in Outlook Version 2003.

You can try to use the following code to remove the birthday entry:

Public Sub RemoveBirthDay(ByVal strBirthDay As String, ByVal strName As
String)

Dim objCalendar As Outlook.AppointmentItem
Dim strFind As String

strFind = "[Subject] = " & strName & Asc(39) & "s " &
"""Birthday"""""
Set objCalendar =
Outlook.Session.GetDefaultFolder(olFolderCalendar).Items.Find(strFind)

If Not objCalendar Is Nothing Then
If objCalendar.Start = strBirthDay Then objCalendar.Delete
End If

End Sub

If you have anniversaries in your contact you need to delete these too.

Best Regards
Peter

--
Peter Marchert
[EDP-Service Marchert]
Homepage: Http://Www.Marchert.De
Excel- And Outlook Programming