Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!
Retrieve Distribution Lists from a List of Outlook Names
This is a variation of the macro produced for question ID 27974272.
In that macro (see below), you enter several distribution lists in a spreadsheet and the output on the spreadsheet page is Member Names with the distribution lists.
For this macro, the Outlook Object Library has to be chosen with VBA, Tools, References.
In this new macro, I would like to be able to enter Member Names and have their distribution lists with the original member names produced.
In that macro (see below), you enter several distribution lists in a spreadsheet and the output on the spreadsheet page is Member Names with the distribution lists.
For this macro, the Outlook Object Library has to be chosen with VBA, Tools, References.
In this new macro, I would like to be able to enter Member Names and have their distribution lists with the original member names produced.
Sub GetDistributionListMembers()
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Dim addrLists As AddressLists
Set addrLists = objNamespace.Session.AddressLists
Dim addrList As AddressList
For Each addrList In addrLists
If addrList.Name = "All Groups" Then
Set myAddrList = addrList
Exit For
End If
Next
idxLine = 1
ActiveSheet.Range("A1") = "Chosen Dist List"
ActiveSheet.Range("C1") = "Member name"
ActiveSheet.Range("D1") = "Dist List"
For Each Entry In myAddrList.AddressEntries
If Entry.DisplayType = olDistList Then
For Each c In Range("Chosen_Dist_List")
If c.Value = Entry.Name Then
For Each Mem In Entry.Members
If Mem.DisplayType = olUser Or Mem.DisplayType = olRemoteUser Then
ActiveSheet.Range("C" & idxLine + 1) = Mem.Name
ActiveSheet.Range("D" & idxLine + 1) = Entry.Name
idxLine = idxLine + 1
End If
Next
End If
Next
End If
Next
End Sub
Do more with
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
I think this is what you're looking for:
Sub GetMemberDistributionLists()
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Dim addrLists As AddressLists
Set addrLists = objNamespace.Session.AddressLists
Dim addrList As AddressList
For Each addrList In addrLists
If addrList.Name = "All Groups" Then
Set myAddrList = addrList
Exit For
End If
Next
idxLine = 1
ActiveSheet.Range("A1") = "Chosen Members"
ActiveSheet.Range("C1") = "Member name"
ActiveSheet.Range("D1") = "Dist List"
For Each entry In myAddrList.AddressEntries
If entry.DisplayType = olDistList Then
For Each mem In entry.Members
For Each c In Range("Chosen_Member_Names")
If (mem.DisplayType = olUser Or mem.DisplayType = olRemoteUser) _
And c.Value = mem.Name Then
ActiveSheet.Range("C" & idxLine + 1) = mem.Name
ActiveSheet.Range("D" & idxLine + 1) = entry.Name
idxLine = idxLine + 1
End If
Next
Next
End If
Next
End Sub
Thanks for the quick response time, but when I run it I get:
Run-time error '1004':
Method 'Range' of object '_Global' failed.
--------------------------
When I choose debug, the following line is highlighted:
For Each c In Range("Chosen_Member_Names
Run-time error '1004':
Method 'Range' of object '_Global' failed.
--------------------------
When I choose debug, the following line is highlighted:
For Each c In Range("Chosen_Member_Names
Sorry. I should have mentioned something about that. Your other subroutine relied on the named range "Chosen_Dist_List"; I wrote the new subroutine to use the named range "Chosen_Member_Names".
If you'd prefer another name or a different way to refer to the range where the member names are located, the line that's failing can easily be tweaked accordingly.
If you'd prefer another name or a different way to refer to the range where the member names are located, the line that's failing can easily be tweaked accordingly.
I have attached the spreadsheet that was used for the Getting the People for Lists.
Could you tweak it so it would work with your code for Getting the Lists for People.
Thanks,
Alex
GetLists.xlsm
Could you tweak it so it would work with your code for Getting the Lists for People.
Thanks,
Alex
GetLists.xlsm
Updated spreadsheet is attached. The "Getting Lists for People" uses Tabelle2.
I also did a little cleanup to the subroutines:
I also did a little cleanup to the subroutines:
put constants at the top of the file
all variables are explicitly defined
contents of columns C and D are removed before the results are generated
macro ends gracefully if it cannot find 'All Groups'
GetLists.xlsm
I tried both tabs.
The first tab and macro works, but I get an error with the second one.
The error is:
Run-time error
'-590331899 (dcd04005)':
When I choose debug, I get "For Each mem In entry.Members" highlighted.
idxLine = 1
For Each entry In myAddrList.AddressEntries
If entry.DisplayType = desiredType Then
For Each mem In entry.Members
If (mem.DisplayType = olUser Or mem.DisplayType = olRemoteUser) Then
For Each c In Range(namedRangeMembers)
If c.Value = mem.Name Then
ActiveSheet.Range("C" & idxLine + 1) = mem.Name
ActiveSheet.Range("D" & idxLine + 1) = entry.Name
idxLine = idxLine + 1
End If
Next
End If
Next
End If
Next
End Sub
GetMembersAndLists.xlsm
The first tab and macro works, but I get an error with the second one.
The error is:
Run-time error
'-590331899 (dcd04005)':
When I choose debug, I get "For Each mem In entry.Members" highlighted.
idxLine = 1
For Each entry In myAddrList.AddressEntries
If entry.DisplayType = desiredType Then
For Each mem In entry.Members
If (mem.DisplayType = olUser Or mem.DisplayType = olRemoteUser) Then
For Each c In Range(namedRangeMembers)
If c.Value = mem.Name Then
ActiveSheet.Range("C" & idxLine + 1) = mem.Name
ActiveSheet.Range("D" & idxLine + 1) = entry.Name
idxLine = idxLine + 1
End If
Next
End If
Next
End If
Next
End Sub
GetMembersAndLists.xlsm
In Excel, if your "Developer" tab is not showing, click on the Office button, choose Excel options, and then put a check mark next to "Show Developer tab in the ribbon".
Click on the Developer tab and then click on "Visual Basic Editor". From the Tools menu choose "References". Make sure that "Microsoft Office x.x Object Library" and "Microsoft Outlook x.x Object Library" are both checked (where x.x stands for the version number).
If either is not checked, scroll down through the list until you find the right one. I think you'll probably find version 14.0 on your computer, but choose whatever version you have.
Click on the Developer tab and then click on "Visual Basic Editor". From the Tools menu choose "References". Make sure that "Microsoft Office x.x Object Library" and "Microsoft Outlook x.x Object Library" are both checked (where x.x stands for the version number).
If either is not checked, scroll down through the list until you find the right one. I think you'll probably find version 14.0 on your computer, but choose whatever version you have.
I think the problems may be time-outs or lock-outs from the network.
Since it is large corporate environment, I may have to go to the administrators for the information. Thanks for the efforts. I will give you the points.
Double-checked. Yes, I do have them (see first image below)
I still get the error messages.
The first macro GetDistributionListMembers
Then, at 30 seconds there is the message:
Outlook is trying retrieve data from the Microsoft Exchange Server Outlook.xxx.xxx
Since it is large corporate environment, I may have to go to the administrators for the information. Thanks for the efforts. I will give you the points.
Double-checked. Yes, I do have them (see first image below)
I still get the error messages.
The first macro GetDistributionListMembers
Then, at 30 seconds there is the message:
Outlook is trying retrieve data from the Microsoft Exchange Server Outlook.xxx.xxx
Premium Content
You need an Expert Office subscription to comment.Start Free Trial