Add Members GAL
 

I can delete Members of a Distrubution List in the GAL but i can't add
Members Why and How can i do this?

Thank you for your help?

My 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

Add Members GAL
 

This is an Excel group.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

wrote in message
oups.com...
I can delete Members of a Distrubution List in the GAL but i can't add
Members Why and How can i do this?

Thank you for your help?

My 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