Outlook Kontaktordner
24.07.2015 11:07:37
Benny
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, 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