Makro für Outlook um Nokia Handy richtig zu synchronisieren

Hallo zusammen,
habe bzgl VBA gar keine Ahnung und folgendes Problem. Synchronisiere ein Nokia Handy, das nur nach Vornamen sortiert. Sehr lästig. Also gesucht. Einige schlaue Leute haben einen Makro geschrieben, der Vor- und Nachnamen vertauscht (und scheinbar noch einiges mehr)und diese Datei wird dann zum synchronisieren des Handys verwendet.

Beigefügt der Code:
———————–
\’ VBA Programm zum Verbessern der Synchronisation mit Nokia-Handys via Nokia Suite
Sub ErstelleNokiaKontakte()
\’——— Konstanten, jeweils individuell anzupassen: ———
Const cPersFolder As String = \”Max Mustermann\” \’ Outlook Postfach
Const cLocalFolder As String = \”Max Mustermann\” \’ Persönlicher Ordner (sofern vorhanden, ansonsten gleich wie persönlicher Ordner
Const cSrcFolder As String = \”Contacts\” \’ Kontaktordner im Outlook Postfach
Const cDestFolder As String = \”Nokia-Adressbuch\” \’ Name für einen temporären Odner in \’cSrcFolder\’. Wird ggf. automatisch angelegt, muss hier nicht geändert werden
Const cSrcSubFolder As String = \”Handy-Speicher\” \’ Name für einen UnterOdner in \’cSrcFolder\’ oder \”\” (emtpy String)
Const cDelObj As String = \”Gelöschte Objekte\” \’ Name des Ordners für gelöschte Objekte in cLocalFolder
Const cNokiaPath As String = \”C:\\Programme\\Nokia\\Nokia PC Suite 6\\PcSync2.exe\” \’ Datei-Pfad von Nokia PC Sync
\’—————————————————————
Dim myOlApp As Application
Dim myNameSpace As NameSpace
Dim myAllFolders As Folders
Dim myPersFolder As MAPIFolder
Dim myLocalFolder As MAPIFolder
Dim mySrcFolder As MAPIFolder
Dim myDestFolder As MAPIFolder
Dim myOldDestFolder As MAPIFolder
Dim myDelFolder As MAPIFolder
Dim myOldDelFolder As MAPIFolder
Dim myItems As Items
Dim myItemNew
Dim myContact As ContactItem
Dim Counter As Long
Dim varResponse As VbMsgBoxResult
Dim Found As Boolean
Set myOlApp = CreateObject(\”Outlook.Application\”)
Set myNameSpace = myOlApp.GetNamespace(\”MAPI\”)
Set myAllFolders = myNameSpace.Folders
Set myPersFolder = myAllFolders.Item(cPersFolder)
Set myLocalFolder = myAllFolders.Item(cLocalFolder)
Set mySrcFolder = myPersFolder.Folders.Item(cSrcFolder)
\’============== SubFolder suchen, und wenn gefunden auch verwenden ==============
useSubFolder = False
If cSrcSubFolder \”\” Then
For Each testmySrcSubFolder In mySrcFolder.Folders
If testmySrcSubFolder.Name = cSrcSubFolder Then
useSubFolder = True
Set mySrcSubFolder = mySrcFolder.Folders.Item(cSrcSubFolder)
Exit For
End If
Next
End If
\’============== ZielOrdner suchen oder neu erzeugen ==============
Found = False
For Each myOldDestFolder In myLocalFolder.Folders
If myOldDestFolder.Name = cDestFolder Then
Set myDestFolder = myOldDestFolder
Found = True
Exit For
End If
Next
If Not Found Then \’then add new folder
Set myDestFolder = myLocalFolder.Folders.Add(cDestFolder, olFolderContacts)
End If
\’============== Kontakte im Ziel-Ordner löschen ==============
\’ alle Kontakte im Ziel-Ordner auflisten, …
Set myItems = myDestFolder.Items
\’ … und löschen
For Each myItem In myItems
myItem.Delete
Next
\’============== Kontakte im Source-Ordner (oder Unterordner) kopieren ==============
Set myItems = mySrcFolder.Items
If useSubFolder = True Then
Set myItems = mySrcSubFolder.Items
End If
\’ … Verteilerlisten filtern …
strContactFilter = \”[MessageClass] = \’IPM.Contact\’\”
Set myItems = myItems.Restrict(strContactFilter)
\’ … und dann in ZielOrdner kopieren
For Each myItem In myItems
Set myItemNew = myItem.Copy
myItemNew.Move myDestFolder
Next
\’============== die kopierten Kontakte für Synchronisation vorbereiten: ==============
Set myItems = myDestFolder.Items
Counter = 0
For Each myContact In myItems
With myContact
\’ es ist auf jeden Fall klüger, über FullName zu gehen, weil der Inhalt von FullName in Outlook konfigurierbar ist.
.FirstName = .FullName
.MiddleName = \”\”
.LastName = \”\”
\’ es gibt aber folgende Alternativ-Methode (Vertauschen von Vor- und Nachname):
\’temp_var = .FirstName
\’.FirstName = .LastName
\’.LastName = temp_var
.Business2TelephoneNumber = trimPhone(.Business2TelephoneNumber)
.BusinessFaxNumber = trimPhone(.BusinessFaxNumber)
.BusinessTelephoneNumber = trimPhone(.BusinessTelephoneNumber)
.CallbackTelephoneNumber = trimPhone(.CallbackTelephoneNumber)
.CarTelephoneNumber = trimPhone(.CarTelephoneNumber)
.CompanyMainTelephoneNumber = trimPhone(.CompanyMainTelephoneNumber)
.Home2TelephoneNumber = trimPhone(.Home2TelephoneNumber)
.HomeFaxNumber = trimPhone(.HomeFaxNumber)
.HomeTelephoneNumber = trimPhone(.HomeTelephoneNumber)
.ISDNNumber = trimPhone(.ISDNNumber)
.MobileTelephoneNumber = trimPhone(.MobileTelephoneNumber)
.OtherFaxNumber = trimPhone(.OtherFaxNumber)
.OtherTelephoneNumber = trimPhone(.OtherTelephoneNumber)
.PrimaryTelephoneNumber = trimPhone(.PrimaryTelephoneNumber)
.RadioTelephoneNumber = trimPhone(.RadioTelephoneNumber)
\’falls es Probleme mit den Geburtstagen gibt, dann bitte die folgenden Zeilen aktiv machen:
.Birthday = \”00:00:00 1.1.4501\”
.Anniversary = \”00:00:00 1.1.4501\”
\’ folgende Zeile aktivieren bei Outlook 2003!!
If .HasPicture Then .RemovePicture
.Save
End With
Counter = Counter + 1
Next myContact
\’============== Gelöschte Kontakte aus Papierkorb entfernen. ==============
Set myDelFolder = myLocalFolder.Folders.Item(cDelObj)
\’ Alle Kontakte im Papierkorb auflisten, …
Set myItems = myDelFolder.Items
\’ … Verteilerlisten filtern …
strContactFilter = \”[MessageClass] = \’IPM.Contact\’\”
Set myItems = myItems.Restrict(strContactFilter)
\’ … und löschen
For Each myItem In myItems
myItem.Delete
Next
\’============== Nokia PC Sync starten? ==============
varResponse = MsgBox(Str(Counter) + \” Kontakte in temporären Ordner \’\” + myDestFolder.Name + \”\’ kopiert.\” + Chr(10) + Chr(13) + \” Soll \’Nokia PC Sync\’ gestartet werden?\”, vbQuestion + vbYesNo, \”Nokia Synchronisation\”)
\’ falls ja:
If varResponse = vbYes Then
Shell cNokiaPath, vbNormalFocus
End If
End Sub
\’ ========== diese Unterfunktion optimiert die Telefonnummern: ==========
Function trimPhone(pno As String) As String
Dim phoneno As String
\’ führende eingeklammerte Nullen, überflüssige Klammern, Leerzeichen und \”-\” bei Durchwahl entfernen
phoneno = Replace(Replace(Replace(Replace(Replace(pno, \”(0\”, \”\”), \”)\”, \”\”), \” \”, \”\”), \”-\”, \”\”), \”(\”, \”\”)
\’ Vorwahlen ohne Landeskennzahl durch +xy ergänzen:
If Left(phoneno, 1) = \”0\” And Left(phoneno, 2) \”00\” Then
phoneno = Replace(phoneno, \”0\”, \”+49\”, 1, 1)
End If
\’führende Doppelnull durch \’+\’ ersetzen
If Left(phoneno, 2) = \”00\” Then
phoneno = Replace(phoneno, \”00\”, \”+\”, 1, 1)
End If
trimPhone = phoneno
End Function

———————–

Bei mir hakt der Makro aber immer an der Stelle

Set myOlApp = CreateObject(\”Outlook.Application\”)
Set myNameSpace = myOlApp.GetNamespace(\”MAPI\”)

Gehe ich mit der Maus darüber wird gezeigt \”myOLApp = Nothing\” …
Was läuft hier verkehrt?

Eine weitere Nokia Eigenart ist, dass nur EINE Telefonnummer angezeigt wird, auch wenn mehrere hinterlegt sind. Wie könnte ein Kontakt mit zB 5 Tel.nummern in 5 Kontakte mit einer Nummer gewandelt werden?

Freundliche Grüsse,
Ingo