i found this code on outlook.net
can anyone be so kind and help me to extend the code to
->check if the birthday is already in the calender
->if it is there
->go to the next contakt.
To avoid double birthdayentries.
Thanks for your replay
E.Zenker
Sub BirthdayImport()
' Quelle: Unbekannter Autor - Vielen Dank!
' Ich habe nur die Kommentare und die Messageboxen hinzugefügt
MsgBox "Dieses Makro erzeugt jährliche Termine aus den Geburtstagen der
Kontakte." & vbCrLf & "Wählen Sie im folgenden Dialog den Kontakteordner
aus, den dieses Makro durchsuchen soll.", vbInformation, "Geburtstage im
Kalender eintragen"
Dim myFolder As MAPIFolder
' Öffne Ordner-Dialog zum Auswählen des Kontakte-Ordners
Set myFolder = Session.PickFolder
For i = myFolder.Items.Count To 1 Step -1
If myFolder.Items(i).Class = 40 Then
myFolder.Items(i).Display
' den richtigen Geburtstag in mybirthday merken
mybirthday = myFolder.Items(i).Birthday
' Geburtstag mit beliebigem Datum überschreiben,
' um eine Änderung zu erzeugen
myFolder.Items(i).Birthday = "12.12.2000 "
' nun wieder richtiges Datum aus mybirthday eintragen
myFolder.Items(i).Birthday = mybirthday
' Kontakt erneut speichern.
' Jetzt arbeitet Outlook im Hintergrund automatisch und erstellt
' einen jährlichen Eintrag im Kalender
myFolder.Items(i).Save
' Kontakt schließen
myFolder.Items(i).Close 0
End If
' zum nächsten Kontakt gehen und alles wieder von vorne
Next i
MsgBox "Fertig!" & vbCrLf & "Es wurden " & myFolder.Items.Count & " Kontakte
durchsucht.", vbInformation, "Information"
End Sub
|
Similar Threads
