Sleeper: Macro to remove contact from multiple distribution lists?

[NZB]

Hi all,

Hoping to find some VBA rockstars who can help me with a recurring issue. Basically, I need a better way to manage all my email distribution lists for work - and I have dozens of them.

Different lists may or may not contain the same contact, and often people are scattered willy nilly across all different lists with no rhyme or reason.

As of now, when I get an 'unsubscribe' I open up each and every distribution list, search for the contact, and delete them from the list, though I don't want to delete the contact altogether (just from the various dist lists).

Is it possible to write a macro to somehow automate this laborious process? Ideally I could run a macro to bring up a master dist list of some kind, from which I could remove the names that need to be removed.

Any help on this is greatly appreciated.

Thanks!
NZB

[Charlize]

To get you started ... the code will loop through all your contacts in the default contactsfolder and determine if it's a distributionlist or not. If so, all the members of the distributionlist will be checked against the value you gave at the beginning. It's based on the name. The code sets everyting in uppercase (charlize = CHARLIZE = Charlize ...). ie. All the distributionlists will be checked against the name if you answer yes to it and will be deleted if found.

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
Charlize

[NZB]

Thanks much - this is absolutely perfect in the way it's set up, couldn't ask for more - unfortunately it's not actually removing the contact from the dist list. I installed and re-installed, ran it on multiple names etc, and no luck. It does find the lists no problem, but no mater what the last screen comes up saying 'Bill Smith was deleted from: ' with nothing after it, indicating (correctly) bill smith wasn't deleted from the dist list after all.

[Charlize]

I think you're not using the most recent version of this coding. Look at this part (and especially the line in red) :

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
and also the declaration part at the start of the coding :

'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

As an alternative we could run this code when you selected an unsubsribe email by using the e-mail address (so you don't have to type a thing) of the e-mail. Off course you should alter this coding a bit to get the emailaddress in the variable thename. And instead of
mydistlist.GetMember(nameloop).Namewe should use
mydistlist.GetMember(nameloop).Adress to check on the e-mail address and not on the name.

Charlize

[Charlize]

To test I would say add a testname to one of your distributionlists and recopy the coding (because I edited it and maybe you copied it before I did). Let's say you add Testing as name and some fake emailadress. Now run the code and type testing. Normally the code will run through all distributionlists and will ask (no matter if testing exists on the list that will be checked) to remove this name from the list. If you say no, the code will skip this list and move on with the next one. If you say yes, the code will check but will do nothing if it's not on the list. If it's on the list, it will be deleted.

I ask this because it runs fine for me.

Charlize

[NZB]

Thanks Charlize, but still no success. I cut and pasted the new code (see attachment) and ran it but still the same. All the right boxes come up, search for the name and ask if I want to remove from the Dist Lists it's found with the persons name.

I choose 'YES' and get the following message (see attachment 2). Looking next in the dist next, I see the contact still listed there. Would it matter that this is Outlook 2007?

[NZB]

Attachment - the new code pasted into Outlook

[Charlize]

She isn't removed from any list. Because otherwise there would stand a distributionlist beneath the : . Something like :
AMANDA WOLT was removed from :
magazine_vba

How does amana wolt appears in the distributionlist. I can guarantee you that it works under 2010, 2007 and 2003. I've tested it myself. I'll maybe look for a different way if I find some time.

Charlize

ps. maybe we gonna try the e-mailaddress approach ...
ps. maybe close your distributionlists before doing this ?
ps. make a separate module for this coding. doesn't need to be in thisoutlooksession

[Charlize]

A different approach. Select one (only one) unsubscribe mail. The coding will use the emailaddress that is used to send this mail. And don't have any lists open. Tested on 2010.

Option Explicit
'Created by : Charlize
'Date : 15 Oct 2010
'Usage : If you want to unsubscribe someone from several distribution lists
' you could try this coding. Stand on an unsubscribe email
' and let this coding do the work. Away the tedious opening and closing
' of all your distribution lists. Doesn't work well with internal exchange
' addresses but gets the job done using normal email addresses
' The distributionlists have a name and email (sometext@someprovider)
'Warning : use at own risk. Try it first on some test distribution list
'******
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
'use a counter to count if we actually do something
Dim result As String, mycounter As Long
'watch out, no errorchecking when pressing cancel
'so better leave it empty when you don't want to do something
'we are gonna process a mailmessage
Dim mymessage As Outlook.MailItem
Set mymessage = ActiveExplorer.Selection.Item(1)
'get the mailaddress
thename = mymessage.SenderEmailAddress
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 LCase(mydistlist.GetMember(nameloop).Address) = LCase(thename) Then
'remove the contact, adding text to end message, change counter
mycounter = mycounter + 1
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
If mycounter > 0 Then
MsgBox result, vbOKOnly
Else
MsgBox thename & " was not found in your lists.", vbOKOnly
End If
Else
MsgBox "No name was given to remove", vbOKOnly
End If
End Sub
Charlize

[NZB]

Voila!! Success :) Fine work Charlize, excellent. I really appreciate your help. Blessings to you and yours.

Best,

Stephen

[NZB]

Hi Charlize,

Any ideas as to why the first version (that searches by contact name) won't work on my machine? This macro is for colleague and myself and it's become apparent that searching and removing by name (from the dist list) is the only practical solution for us, as the notifications often come from a third party email address - thus we can't click on the email to unsubscribe them.

Just wondering if there's something I'm missing as the first version you created works for you, but doesn't for me or my colleague.

Thanks!

Stephen

[Charlize]

Is there some kind of standard format for the messagebody of the unsubscribe mail. Or a standard subject line ? One wrong character and the name can't be found (even it's just a space). An email address must be unique, a name can be duplicated (never tried that one to be honest).

Charlize

[NZB]

Hi Charlize - there is a standard format but it would be much preferable to get it to search by contact as originally intended so others can use it as well. Have posted in another forum to try to find out why it's working for you and not for me. Thanks for your help!

[Charlize]

Hi Charlize - there is a standard format but it would be much preferable to get it to search by contact as originally intended so others can use it as well. Have posted in another forum to try to find out why it's working for you and not for me. Thanks for your help!Where is the link to the other forum ?

Charlize

[NZB]

Sorry - here it is. Not a forum actually, a blog. And the fellow there suggested to me I 'step through it' to see if I can spot the problem, but I don't quite know what I'm looking for in any case.

http://www.codeforexcelandoutlook.com/blog/2010/10/get-the-path-of-any-outlook-item/#comment-2876

[NZB]

I 'stepped into' the macro and got two errors, each the same, saying: 'Run time error. Array Index out of bounds.' Don't know if that means anything or not but thought I'd pass it on.

They were in the following areas of the code (and the text below was highlighted)


In beginning area of code:

Sub dist_list_unsubscribe()

In middle area of code:

Set mymessage = ActiveExplorer.Selection.Item(1)

Best,

Stephen J

[Charlize]

You haven't selected a message. That's the reason the object mymessage can't receive anything.

select a mailmessage (no return receipt, no calendar invitation, ...) by standing on it
hit alt + F11 (open vba editor)
look for coding and stand with cursor inside the macro (sub ...)
hit F8 a lot of times and in the same time hover with your mouse over the variables to see the values of it.That's what he meant with stepping through.

Charlize