He Guys. I found this thread yesterday and tried to code a little script in Outlook to solve the problem. I think, my script do the same thing like the commercial plug-in by the other forum-lady, but for free.
I use Outlook 2003 und wrote it with the internal VBA-ToolBox.
Sub ContactDateCheck()
Dim myOlApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace 'wird auf die aktuelle Outlook-App referenziert
Dim myContacts As Outlook.Items 'beinhaltet die gesamte Kontaktliste
Dim myItem As Object 'Durchläuft alle Objekte aus myContacs
Dim bkUp As Date 'Hier wird das richtige Datum drinne gespeichert
Dim objRem As Reminder
Dim objRems As Reminders
Dim vglInt As Integer
Set myOlApp = CreateObject("Outlook.Application")
Set myNamespace = myOlApp.GetNamespace("MAPI")
Set myContacts = myNamespace.GetDefaultFolder(olFolderContacts).Items 'Hier sind jetzt alle Kontakte im Standardordner gespeichert
'Alle Reminders zusammenstellen und prüfen, ob es nicht schon einen gibt
Set objRems = myOlApp.Reminders
For Each myItem In myContacts 'Schleife, damit jeder Kontakt bearbeitet wird
If (myItem.Class = olContact) Then 'Wenn es ein Kontakt ist
If objRems.Count <> 0 Then 'Wenn es Reminder gibt
For Each objRem In objRems 'Alle Reminder durchluafen
If vglInt = 0 Then
vglInt = Strings.InStr(1, objRem.Caption, myItem.LastName, vbTextCompare) 'Falls es einen Reminder mit dem Geburtstag gibt für die entsprechende Person
If vglInt <> 0 Then
vglInt = Strings.InStr(1, objRem.Caption, myItem.FirstName, vbTextCompare)
If vglInt <> 0 Then
vglInt = Strings.InStr(1, objRem.Caption, "Geburtstag", vbTextCompare) 'prüft, ob es wirklich ein Geburtstag ist
End If
End If
End If
Next objRem
If vglInt = 0 Then 'wenn es sowas gibt, dann soll keine neue Erinnerung erstellt weirden
bkUp = myItem.Birthday 'speichert den aktuellen Kontakt als Backup
myItem.Birthday = bkUp 'setzt halt wieder auf das selbe Datum, dabei wird der automatische Reminder gesetzt
MsgBox myItem.FullName & " Innere: " & myItem.Birthday & ": " & "Verändert und Geburtstagserinnerung gestellt"
myItem.Save 'speichert
End If
vglInt = 0
Else 'wenn es keine Reminder gibt, muss alles ersetzt weirden
bkUp = myItem.Birthday 'speichert den aktuellen Kontakt als Backup
myItem.Birthday = bkUp 'setzt halt wieder auf das selbe Datum, dabei wird der automatische Reminder gesetzt
MsgBox myItem.FullName & "Äußere: " & myItem.Birthday & ": " & "Verändert"
myItem.Save 'speichert
End If
End If
Next
End Sub
Sorry for the german comments, its my nativ langauge.
If you find some bugs, please contact me to fix it. But remember, use it at your own risk!
