Seite 2 von 2
Verfasst: Fr 20. Aug 2010, 13:25
von Meister Propper
MPE: Also die Geburtstage hab ich über die Kontakte eingefügt. Alle um 15:00Uhr.
Ich hab auch nur den Kalender synchronisiert. Werde mal versuchen auch die Kontakte mit zu synchronisieren...oder nur die Kontakte ohne Kalender...
Danke für deine Hilfe, FJ!
Mfg. Meister Propper
Verfasst: Sa 21. Aug 2010, 13:50
von Meister Propper
Sooo...Gelöst:
Also man füttere Outlook mit den Kontakten aus dem MyPhoneExplorer. Die Kontakte haben z.T. einen Gebutstagseintrag, diese sollen in den Kalender. Dann im Outlook Alt+F11 drücken, Im linken Bereich den Baum „Projekt1″ solange expandieren, bis „ThisOutlookSession“ erscheint -> doppelklicken und im erscheinenden Editorfenster einfügen:
Code: Alles auswählen
Sub GeburtstagJahrestagImport()
Dim myNameSpace As NameSpace
MsgBox "Diese Routine wird alle Geburtstage und Jahrestage erneut anlegen und vorher alle alten löschen. Bitte wählen Sie im folgenden den Ordner aus, der Ihre Kontaktdaten beinhaltet.", vbInformation, "Geburtstage Import"
Set myOlApp = New Outlook.Application
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Call DeleteAllBirthdayAnniversary(myNameSpace)
Set myFolder = Session.PickFolder
Set myFolder = myNameSpace.GetDefaultFolder(olFolderContacts)
For i = myFolder.Items.Count To 1 Step -1
myFolder.Items(i).Display
mybirthday = myFolder.Items(i).Birthday
If mybirthday <> "1/1/4501" Then
myFolder.Items(i).Birthday = "1/1/4501 "
myFolder.Items(i).Save
myFolder.Items(i).Birthday = mybirthday
myFolder.Items(i).Save
End If
myAnniversary = myFolder.Items(i).Anniversary
If myAnniversary <> "1/1/4501" Then
myFolder.Items(i).Anniversary = "1/1/4501 "
myFolder.Items(i).Save
myFolder.Items(i).Anniversary = myAnniversary
myFolder.Items(i).Save
End If
myFolder.Items(i).Close 0
Next i
Call ResetAllBirthdayAnniversary(myNameSpace)
MsgBox "Fertig!" & vbCrLf & myFolder.Items.Count & " Kontakte bearbeitet.", vbInformation, "Geburtstag / Jahrestag Import"
End Sub
Sub DeleteAllBirthdayAnniversary(myNameSpace As NameSpace)
Set myFolder = myNameSpace.GetDefaultFolder(olFolderCalendar)
Set myItems = myFolder.Items
For i = myFolder.Items.Count To 1 Step -1
If InStr(myItems(i).Subject, "Geburtstag") > 0 Or InStr(myItems(i).Subject, "Jahrestag") > 0 Then
myItems(i).Delete
End If
Next
End Sub
Sub ResetAllBirthdayAnniversary(myNameSpace As NameSpace)
Set myFolder = myNameSpace.GetDefaultFolder(olFolderCalendar)
Set myItems = myFolder.Items
For i = myFolder.Items.Count To 1 Step -1
If InStr(myItems(i).Subject, "Geburtstag") > 0 Or InStr(myItems(i).Subject, "Jahrestag") > 0 Then
myItems(i).ReminderMinutesBeforeStart = 0
With myItems(i).GetRecurrencePattern()
.StartTime = TimeSerial(15, 0, 0)
.Duration = 0
End With
myItems(i).Save
End If
Next
End Sub
Dann speichern und aufs "Play"-Symbol klicken oder Fenster schließen und im Outlook „Extras“ -> „Makro“ -> „Makros“ auswählen und ausführen.
So trägt Outlook jeden Gebutstag in den Kalender um 15Uhr ein. Die Erinnerung kommt dann auch um 15Uhr
Jetzt kann man die Nokia PC-Suite mit Outlook synchronisieren und alles is fein
@Outlook: Benutzerunfreundlichstes Software ever!
Mfg. Meister Propper
//EDIT: Geholfen hat mir sehr:
http://www.office-loesung.de/ftopic5267 ... 1e5a9fe0b0