Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Members hinzufügen Globales Adressbuch
Hallo kann Mitglieder (Email Adressen) in einem Verteiler im Globalem
Adressbuch löschen aber nicht hinzufügen. Warum bzw. Wie kann ich dies tuen. Danke für eurere Antworten Mein Code: Sub CoppyVerteilerliste() Dim appOL As New Outlook.Application 'Outlook-Referenz Dim oApp As Outlook.Application Dim oNS As Outlook.NameSpace Dim oGal As Outlook.AddressList Dim objNS As Outlook.NameSpace 'Namespace-Referenz Dim objFld As Outlook.MAPIFolder 'Kontaktordner-Referenz Dim objDLold As Outlook.DistListItem 'alte (zu bearbeitende) Verteilerliste Dim olAdressListe As Outlook.AddressList Dim oALs As Outlook.AddressLists Dim olAdressListEintrag As Outlook.AddressEntry Dim olFolder As Outlook.MAPIFolder Dim List As Outlook.AddressEntries Dim Item As Outlook.ContactItem Dim Name As String Dim sDLName As String Dim oEntry As Outlook.AddressEntry Dim oDL As Outlook.AddressEntry Dim myRecipients As Outlook.Recipients Dim mAddressEntry As Outlook.AddressEntry Dim CdoAddressEntryNewMember Dim oNewMember As AddressEntry Dim z As Integer Dim a As Integer Set oApp = Outlook.Application Set oNS = oApp.Session Set oALs = oNS.AddressLists Set objNS = appOL.GetNamespace(Type:="MAPI") Set myTempItem = oApp.CreateItem(olMailItem) Set myRecipients = myTempItem.Recipients Set oGal = oALs.Item("Globales Adressbuch") Set oEntries = oGal.AddressEntries Set oEntry = oEntries.GetFirst Set objDLold = oApp.CreateItem(olDistributionListItem) Set objNS = appOL.GetNamespace("MAPI") 'MAPI-Referenz erstellen Set olFolder = objNS.GetDefaultFolder(olFolderContacts) sDLName = InputBox("Bitte den Verteilername Eingeben") If sDLName = "" Then MsgBox "Nochmal starten und Verteiler eingeben" End Else Set oDL = oEntries.Item(sDLName) objDLold.DLName = oDL.Name Do Until oDL.Members.Count = 0 For z = 2 To oDL.Members.Count 'Schleife durchläuft alle Members von den Verteilerlisten 'myRecipients.Add oDL.Members.Item(z) ' oDL.Members.Add myRecipients On Error Resume Next oDL.Members.Item(z - 1).Delete 'Möglichkeit um die Members von den Verteilerlisten zu löschen On Error Resume Next Next z If oDL.Members.Count = 1 Then oDL.Members.Item(1).Delete On Error Resume Next End If Loop Range("A2").Select Do Until ActiveCell.Value = "" myRecipients.Add ActiveCell.Value ActiveCell.Offset(1, 0).Select Loop myRecipients.ResolveAll MsgBox oDL.Type ' Set oNewMember = oDL.Members.Add("EX", "adler", ") 'myRecipients MsgBox olFolder.Items.Count ' oDL.Members.Add = mAdressEntry olFolder.Items.Add myRecipients If MsgBox("Wollen Dass Die Liste gespeichert wird?", vbQuestion + vbYesNo) = vbYes Then objDLold.Save objDLold.Display Else End End If End If End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How do I obtain the average age of our members? | Excel Worksheet Functions | |||
enumeration members | Excel Worksheet Functions | |||
Autolist Members Does Not Always Work | Excel Programming | |||
help! dimension members how to not be selected by default | Excel Discussion (Misc queries) | |||
Members in a PageField | Excel Programming |