Hi all,
Here is a sweet macro to remove a contact from multiple distribution lists - an extrememly time consuming task if you've got the same contact over multiple lists! Trouble is it works for the person that created it but not for me or for my colleague. It goes through all the steps brilliantly - just fails to actually remove the person from any lists.
Anyone know why? Does it work for you?
Running Vista, Outlook 2007.
Thanks much
Sub dist_list_unsubscribe()
'folder of your contacts
Dim myFolder As Outlook.MAPIFolder
'vloop = loop through contacts, thename = name of contaxct
'nameloop = loop through items in the distributionlist
Dim vloop As Long, thename As String, nameloop As Long
'the distributionlist
Dim mydistlist As DistListItem
'the item in the distributionlist
Dim myrecipient As Outlook.Recipient
'create a message at the end of processing the request
Dim result As String
'watch out, no errorchecking when pressing cancel
'so better leave it empty when you don't want to do something
thename = InputBox("Give name to remove from distributionlists ...")
If thename <> vbNullString Then
result = thename & " was removed from :" & vbCrLf
MsgBox "Search for " & thename & " at my distributionlists."
Set myFolder = Application.Session.GetDefaultFolder(olFolderContacts)
'loop through all your items in the contactsfolder
For vloop = 1 To myFolder.Items.Count
'Check if the class of an item is contact, distribution
'or something else. We only want to check distributionlists
If myFolder.Items(vloop).Class = olDistributionList Then
'put the distributionlist in a holder
Set mydistlist = myFolder.Items(vloop)
'ask a question to remove from this group
If MsgBox("Remove " & thename & " from " & myFolder.Items(vloop), vbYesNo) = vbYes Then
'if no members in distributionlist, don't process it
If mydistlist.MemberCount = 0 Then
MsgBox "No members in : " & mydistlist
Else
'loop through each member to decide if name matches a member
'from last one till first one
For nameloop = mydistlist.MemberCount To 1 Step -1
'we put everything in uppercase because we are human and don't
'recall the exact input of a members name
If UCase(mydistlist.GetMember(nameloop).Name) = UCase(thename) Then
'remove the contact, adding text to end message
result = result & mydistlist & vbCrLf
Set myrecipient = mydistlist.GetMember(nameloop)
mydistlist.RemoveMember myrecipient
End If
Next nameloop
'save the distributionlist
mydistlist.Save
End If
End If
End If
Next vloop
MsgBox result, vbOKOnly
Else
MsgBox "No name was given to remove", vbOKOnly
End If
End Sub
Here is a sweet macro to remove a contact from multiple distribution lists - an extrememly time consuming task if you've got the same contact over multiple lists! Trouble is it works for the person that created it but not for me or for my colleague. It goes through all the steps brilliantly - just fails to actually remove the person from any lists.
Anyone know why? Does it work for you?
Running Vista, Outlook 2007.
Thanks much
Sub dist_list_unsubscribe()
'folder of your contacts
Dim myFolder As Outlook.MAPIFolder
'vloop = loop through contacts, thename = name of contaxct
'nameloop = loop through items in the distributionlist
Dim vloop As Long, thename As String, nameloop As Long
'the distributionlist
Dim mydistlist As DistListItem
'the item in the distributionlist
Dim myrecipient As Outlook.Recipient
'create a message at the end of processing the request
Dim result As String
'watch out, no errorchecking when pressing cancel
'so better leave it empty when you don't want to do something
thename = InputBox("Give name to remove from distributionlists ...")
If thename <> vbNullString Then
result = thename & " was removed from :" & vbCrLf
MsgBox "Search for " & thename & " at my distributionlists."
Set myFolder = Application.Session.GetDefaultFolder(olFolderContacts)
'loop through all your items in the contactsfolder
For vloop = 1 To myFolder.Items.Count
'Check if the class of an item is contact, distribution
'or something else. We only want to check distributionlists
If myFolder.Items(vloop).Class = olDistributionList Then
'put the distributionlist in a holder
Set mydistlist = myFolder.Items(vloop)
'ask a question to remove from this group
If MsgBox("Remove " & thename & " from " & myFolder.Items(vloop), vbYesNo) = vbYes Then
'if no members in distributionlist, don't process it
If mydistlist.MemberCount = 0 Then
MsgBox "No members in : " & mydistlist
Else
'loop through each member to decide if name matches a member
'from last one till first one
For nameloop = mydistlist.MemberCount To 1 Step -1
'we put everything in uppercase because we are human and don't
'recall the exact input of a members name
If UCase(mydistlist.GetMember(nameloop).Name) = UCase(thename) Then
'remove the contact, adding text to end message
result = result & mydistlist & vbCrLf
Set myrecipient = mydistlist.GetMember(nameloop)
mydistlist.RemoveMember myrecipient
End If
Next nameloop
'save the distributionlist
mydistlist.Save
End If
End If
End If
Next vloop
MsgBox result, vbOKOnly
Else
MsgBox "No name was given to remove", vbOKOnly
End If
End Sub
Last edited: