Outlook Kontaktordner

Bild

Betrifft: Outlook Kontaktordner
von: Benny
Geschrieben am: 24.07.2015 11:07:37

Hallo,
ich möchte gerne aus meiner Exceltabelle per VBA Outlookkontakte und eine Verteilerliste erstellen. Das klappt auch alles schon ganz gut, allerding kriege ich es nicht hin, dass die Kontakte bzw. die Verteilerliste in einem bestimmten Kontaktordner erstellt werden.
Konkret: Ich habe auf der gleichen Ebene wie "Meine Kontakte" einen Ordner "Schule" erstellt und darunter einen Unterordner "Klasse 7a".
Nun möchte ich die Kontakte und die Verteilerliste in genau diesem Ordner erstellen und nicht im Ordner "Meine Kontakte" oder einem Unterordner davon.
Der Code sieht wie folgt (nur Erstellung der Verteilerliste) aus:

Sub Verteilerliste()
    Dim appOutlook As New Outlook.Application
    Dim objNS As Outlook.Namespace
    Dim objFolder As Object
    Dim objDistList As Outlook.DistListItem
    Dim objMail As MailItem
    Dim objRcpnts As Recipients
    Dim objRcpnt As Recipient
    Dim i As Long
    Set objNS = appOutlook.GetNamespace("MAPI")
    Set objFolder = objNS.GetDefaultFolder(olFolderContacts)
    'so leider nicht: Set objFolder = objNS.Folders("Schule")
    Set objMail = appOutlook.CreateItem(Outlook.OlItemType.olMailItem)
    Set objRcpnts = objMail.Recipients
    'Namen aus "Tabelle1" auslesen - Spalte A: angzeigter Name, Spalte B: Mail-Adresse
    Sheets("Gesamt").Activate
   For Each cell In Range("AM2:AM31")
      If cell.Value <> "" Then
         Set objRcpnt = objRcpnts.Add("<" & cell.offset(0, 1).Value _
         & cell.Value & "> " & cell.offset(0, 3).Value)
         
      End If
  Next
    Set objDistList = objFolder.Items.Add(Outlook.OlItemType.olDistributionListItem)
    objDistList.DLName = "VerteilerListe_Test"
    objDistList.AddMembers objRcpnts
    objDistList.Display
    objDistList.Save
    Set objDistList = Nothing
    Set objRcpnt = Nothing
    Set objRcpnts = Nothing
    Set objMail = Nothing
    Set objFolder = Nothing
    Set objNS = Nothing
    Set appOutlook = Nothing
End Sub

Bild

Betrifft: AW: Outlook Kontaktordner
von: ede
Geschrieben am: 28.07.2015 09:26:03
Hallo Benny,
und geht es so:
Set objFolder = objNS.GetDefaultFolder(olFolderContacts).Folders("Schule")
Gruss
Ede

Bild

Betrifft: AW: Outlook Kontaktordner
von: Benny
Geschrieben am: 28.07.2015 16:54:52
Hallo Ede,
vielen Dank für deine Antwort. Jetzt habe ich deinen Hinweis in soweit angepasst, dass ich auch Unterordner erstellen kann. Außerdem kann ich jetzt auch Ornder löschen.
Zum Erstellen der Ordner habe ich noch eine Frage: Gibt es eine saubere Lösung einer Abfrage, ob ein Ordner bereits existiert? Auf Dateiebene ist mir das mit dir(...) = "" etc klar.
Für den Outlookkontakteordner habe ich das nun wie folgt realisiert:

Sub outlookKontakteErstellen()
  If debugging Then
    Call variablenVorbereiten
  End If
' Neuen Outlook-Kontakt hinzufügen
  Dim oOutlook As Outlook.Application
  Dim oNameSpace As Outlook.Namespace
  Dim oMAPIFolder, ordner As Outlook.MAPIFolder
  Dim oContact As Outlook.ContactItem
  Dim objMail As MailItem
  Dim mitgliederSchüler, mitgliederEltern, mitglieder As Recipients
  Dim objRcpnt As Recipient
  Dim verteilerliste As Outlook.DistListItem
' Fehlerbehandlung aktivieren
  
  On Error GoTo ErrHandler
 
  ' Outlook-Application-Objekt erstellen
  Set oOutlook = CreateObject("Outlook.Application")
 
  ' Namespace initialisieren
  Set oNameSpace = oOutlook.GetNamespace("MAPI")
 
  ' Kontakt-Ordner verwenden
  Set oMAPIFolder = oNameSpace.GetDefaultFolder(olFolderContacts) '.Folders("Schule") '.Folders( _
"Schule")
  
  'Ordner erstellen bzw. auswählen
  If sek2 Or diff Then
    oName = "Kurs " & kursbezeichnung
  Else
    oName = "Klasse " & kursbezeichnung
  End If
  
  On Error Resume Next
    'Ordner Schule zuweisen
    Set ordner = oMAPIFolder.Folders("Schule")
  'Falls der Ordner nicht existiert, Ordner erstellen
  If ordner Is Nothing Then
    Set ordner = oMAPIFolder.Folders.Add("Schule", olFolderContacts)
    'Erstelle einen Unterordner Klasse 7a
    Set ordner = oMAPIFolder.Folders("Schule").Folders.Add(oName, olFolderContacts)
  Else
    Set ordner = ordner.Folders(oName)
    If ordner Is Nothing Then
      Set ordner = oMAPIFolder.Folders("Schule").Folders.Add(oName, olFolderContacts)
    End If
  End If
  
  On Error GoTo ErrHandler
  
  Set ordner = oMAPIFolder        '' so klappt das Anlegen der Liste
  'Verteilerliste vorbereiten
  Set objMail = oOutlook.CreateItem(Outlook.OlItemType.olMailItem)
  Set mitgliederSchüler = objMail.Recipients
  Set verteilerliste = ordner.Items.Add(Outlook.OlItemType.olDistributionListItem)
  verteilerliste.DLName = "Schüler " & kursbezeichnung
  
  'Kontakte Schüler erstellen
  Sheets("Gesamt").Activate
  Dim cell As Range
  Dim pos As String
  On Error GoTo ErrHandler
  For Each cell In Range("AM2:AM31")
      If cell.Value <> "" Then
        If cell.offset(0, -31).Value = "w" Then
          pos = "Schülerin " & kursbezeichnung
        Else
          pos = "Schüler " & kursbezeichnung
        End If
        ' Objekt für neuen Eintrag erstellen
         Set oContact = ordner.Items.Add
         With oContact
           ' Eigenschaften des Eintrag festlegen
           .LastName = cell.Value
           .FirstName = cell.offset(0, 1).Value
           .Email1Address = cell.offset(0, 3).Value
           '.Birthday = cell.offset(0, -30).Value
           .JobTitle = pos
           .HomeAddressStreet = cell.offset(0, 5).Value
           .HomeAddressPostalCode = cell.offset(0, 7).Value
           .HomeAddressCity = cell.offset(0, 8).Value
           
           .MobileTelephoneNumber = cell.offset(0, 11).Value
           .HomeTelephoneNumber = cell.offset(0, 4).Value
           ' hier können natürlich noch weitere Eigenschaften
           ' für den neuen Kontakt festgelegt werden, wie z.B.
           ' HomeAddressStreet, HomeAddressCity, etc.
           ' (siehe hierzu VB-Objekt-Katalog - Outlook - ContactItem)
           ' ...
           ' Kontakt speichern
           .Save
         End With
        
         'zur Verteilerliste hinzufügen
         Set objRcpnt = mitgliederSchüler.Add(oContact)
         
      End If
  Next
  'Verteilerliste anlegen
  verteilerliste.AddMembers mitgliederSchüler
  verteilerliste.Display
  verteilerliste.Save
...
End Sub

Gibt es da eine bessere Lösung?
Außerdem klappt jetzt leider das Anlegen der Verteilerliste nicht mehr. Die Liste wird zwar erstellt, ist aber leer.
Wenn ich den Ordner so lasse (also Schule->Klasse 7a) dann werden dort die Konatkte erstellt und auch eine leere Verteilerliste wird erstellt. Wenn ich den Standardordner wähle (s. auskommentierte Zeile Set ordner = oMAPIFolder), dann funktioniert alles, allerdings im Standardordner.
Vielen Dank für deine Hilfe
Benny
Vielen Dank
Benny

Bild

Betrifft: AW: Outlook Kontaktordner
von: ede
Geschrieben am: 29.07.2015 10:23:15
Hallo noch mal,
-für die Suche, ob es einen Ordner bereits gibt schau dir mal nachfolgenden Link an, da ist ein gutes Beispiel was Du für Dich anpassen kannst:
http://www.vboffice.net/de/developers/ordner-suchen
-ist die neue Verteilerliste wirklich schon angelegt, bevor Du die Kontakte anlegst und dieser zuordnest?
gruss
Ede

Bild

Betrifft: AW: Outlook Kontaktordner
von: Benny
Geschrieben am: 29.07.2015 18:22:28
Hallo Ede,
vielen Dank für den Link.
Meiner Meinung nach Erstelle ich die Verteilerliste doch mit:
Set verteilerliste = ordner.Items.Add(Outlook.OlItemType.olDistributionListItem)
verteilerliste.DLName = "Schüler " & kursbezeichnung
Dann füge ich die Kontakte in Adressbuch und zur Instanz der Klasse Recipients hinzu:
Set objRcpnt = mitgliederSchüler.Add(oContact)
Und erstelle aus der Instanz der Klasse Recipients die Verteilerliste:
verteilerliste.AddMembers mitgliederSchüler
Das funktioniert auch alles prima, wenn ich mich im Ordner Kontakte bewegen, aber sobald ich in einen Unterordner bzw. einen Unterunterodner wechsle, wir die Verteilerliste erstellt, aber nicht "befüllt".
Hast du noch eine Idee?
Viele Grüße und vielen Dank
Benny

Bild

Betrifft: AW: Outlook Kontaktordner
von: ede
Geschrieben am: 30.07.2015 09:35:42
Hallo Benny,
ich glaube das liegt an: Set objRcpnt = mitgliederSchüler.Add(oContact)
Versuch mal nur den Namen und eMail zu übergeben:
objRcpnt = mitgliederSchüler.Add("<" & [FullName] & "> " & [Email1Address])
An meinem nachgestellten Beispiel funktioniert das so. Gruss
Ede

Bild

Betrifft: AW: Outlook Kontaktordner
von: ede
Geschrieben am: 30.07.2015 12:41:42
lass das Thema noch offen

Bild

Betrifft: AW: Outlook Kontaktordner
von: Benny
Geschrieben am: 31.07.2015 11:06:29
Hallo Ede,
vielen Dank für deine erneute Antwort. Ich hatte diese Lösung auch schon unter: https://www.herber.de/forum/archiv/1148to1152/1150839_Outlook_Kontakte_Verteilerliste_erstellen.html gefunden. Allerdings füge ich die Kontakte ja nun nicht als vorhandene Kontakte, sondern als neue E-Mailkontakte ein. Da ist für mich keine ganz saubere Lösung, da ich die Kontakte ja extra vorher angelegt habe. Aber das soll mir jetzt ersteinmal egal sein. Ich lasse es jetzt so!
Vielen Dank für deinen freundlichen und hilfreichen Support und die Zeit die du darin investiert hast.
Viele Grüße und einen schönen Tag
Benny

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Outlook Kontaktordner"