Makro für Outlook um Nokia Handy richtig zu synchronisieren

Home-›Foren-›Outlook-›Outlook VBA-›Makro für Outlook um Nokia Handy richtig zu synchronisieren

Ansicht von 1 Beitrag (von insgesamt 1)
  • Autor
    Beitrag
  • #38398
    Unbekannt
    Teilnehmer

      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

    Ansicht von 1 Beitrag (von insgesamt 1)

    Du musst angemeldet sein, um auf dieses Thema antworten zu können.

    -