Building a Personal Distribution List in Outlook from an email address list in Excel

janthonyn
janthonyn used Ask the Experts™
on
I'd like to be able to build an email distribution list in Outlook from a column of email addresses in Excel. Is there anyway to do this?
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2010

Commented:
Greetings, janthonyn.

Yes, it's doable with a bit of scripting.  If that's an option, then I can provide the code.

Cheers!

Author

Commented:
Yes, that's an option. Please provide me with the code. Thanks
Top Expert 2010

Commented:
janthonyn,

Here the code for doing this.  Follow these instructions to use it.

1.  Start Outlook
2.  Click Tools->Macro->Visual Basic Editor
3.  If it's not already expanded, expand Modules and click on Module1
4.  Copy the code below and paste it into the right-hand pane of the VB Editor
5.  Edit the code.  I included a comment where something can or needs to change
6.  Click the diskette icon on the toolbar to save the code.
7.  Exit the VB Editor
8.  Click Tools->Macro->Security
9.  Set the Security Level to Medium.
10.  Close Outlook
11.  Start Outlook
12.  Run the macro

Sub MakeDistList()
    Dim olkList As Outlook.DistListItem, _
        olkRecipient As Outlook.Recipient, _
        olkDummyItem As Outlook.MailItem, _
        excApp As Object, _
        excBook As Object, _
        excSheet As Object, _
        intRow As Integer, _
        intCol As Integer, _
        strBuffer As String
    Set olkDummyItem = Application.CreateItem(olMailItem)
    Set olkList = Application.CreateItem(olDistributionListItem)
    Set excApp = CreateObject("Excel.Application")
    'Change the path and filename to that of your spreadsheet
    Set excBook = excApp.Workbooks.Open("C:\eeTesting\Addresses.xls")
    'Change the sheet number as needed
    Set excSheet = excBook.Sheets(1)
    'Change the columna number as needed
    intCol = 1
    'Change the starting row number as needed
    intRow = 1
    Do While True
        strBuffer = excSheet.Cells(intRow, intCol)
        If strBuffer = "" Then
            Exit Do
        Else
            Set olkRecipient = olkDummyItem.Recipients.Add(strBuffer)
            olkRecipient.Resolve
            olkList.AddMember olkRecipient
            intRow = intRow + 1
        End If
    Loop
    'Change the list name as needed
    olkList.DLName = "My Dist List Name"
    olkList.Save
    Set olkDummyItem = Nothing
    Set olkRecipient = Nothing
    Set olkList = Nothing
    Set excSheet = Nothing
    excBook.Close False
    Set excBook = Nothing
    Set excApp = Nothing
    MsgBox "All done!"
End Sub
Should you be charging more for IT Services?

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!

Author

Commented:
Getting an error:

Run-time error '287'
Application defined or object defined error

When I select Debug, cursor goes to
olkList.Save

So is this looking for a place to save the list? Or looking for instructions on where to save it?

For 'Change the path and filename to that of your spreadsheet
I have:
    Set excBook = excApp.Workbooks.Open("\\domain-01.com\dfs$\care-one\users\care-one_nanthony\desktop\Distribution.xls")

I start at row 2 and column 4 and reset those values in the code.
Top Expert 2010
Commented:
janthonyn,

> So is this looking for a place to save the list?
The list will appear in your contacts folder.  You can move it afterwards.  I suspect the problem is being caused by one or more of the addresses in the list.  As a test, how about creating a separate worksheet with one or two addresses in it and see if it imports properly?  I tested this on my system (Windows XP (SP2), Outlook 2003, Excel 2003) using a simple test spreadsheet containing three addresses in the form "name@company.com" (minus the quotes), and everything worked perfectly.

Author

Commented:
A small number of records worked without error. What do I do to ID the problems?

Author

Commented:
Should I open another question for this error problem? If I put an error handling statement in the code, it just completes without creating the distribution list.
Top Expert 2010

Commented:
No need to open another question.  This one isn't finished until the code does what you asked it to do.  There must be something about one of the entries in the spreadsheet with the live data that's causing the code to fail, or there are too many entries for one distribution list.  How many entries are there?

Author

Commented:
Hey, thanks for reminding me about number of entry limit. That was it. When I lowered the number of entries to 100, it worked fine. Excellent!!

Nels
Top Expert 2010

Commented:
Cool.  I could change the code to create multiple lists if that'd help.

Author

Commented:
That would be cool. Thanks!
Top Expert 2010

Commented:
Ok, try this.  It will split the spreadsheet up into multiple lists with 100 entries per list.  If there are multiple lists, then they will be named "My List Name - Part 1" through "My List Name - Part x".  I only ran a quick test on this, but it worked fine.

Sub MakeDistList()
    Dim olkList As Outlook.DistListItem, _
        olkRecipient As Outlook.Recipient, _
        olkDummyItem As Outlook.MailItem, _
        excApp As Object, _
        excBook As Object, _
        excSheet As Object, _
        intRow As Integer, _
        intCol As Integer, _
        intCount As Integer, _
        intPart As Integer, _
        strBuffer As String, _
        strDLName As String
    'Change the root list name on the next line
    strDLName = "My Dist List"
    intPart = 1
    intCount = 1
    Set olkDummyItem = Application.CreateItem(olMailItem)
    Set olkList = Application.CreateItem(olDistributionListItem)
    Set excApp = CreateObject("Excel.Application")
    'Change the path and filename to that of your spreadsheet
    Set excBook = excApp.Workbooks.Open("C:\eeTesting\Addresses.xls")
    'Change the sheet number as needed
    Set excSheet = excBook.Sheets(1)
    'Change the columna number as needed
    intCol = 1
    'Change the starting row number as needed
    intRow = 1
    Do While True
        strBuffer = excSheet.Cells(intRow, intCol)
        If strBuffer = "" Then
            Exit Do
        Else
            Set olkRecipient = olkDummyItem.Recipients.Add(strBuffer)
            olkRecipient.Resolve
            olkList.AddMember olkRecipient
            intRow = intRow + 1
            If intCount = 100 Then
                olkList.DLName = strDLName & " - Part " & intPart
                olkList.Save
                Set olkList = Application.CreateItem(olDistributionListItem)
                intPart = intPart + 1
                intCount = 1
            Else
                intCount = intCount + 1
            End If
        End If
    Loop
    'Change the list name as needed
    olkList.DLName = strDLName & IIf(intPart > 1, " - Part " & intPart, "")
    olkList.Save
    Set olkDummyItem = Nothing
    Set olkRecipient = Nothing
    Set olkList = Nothing
    Set excSheet = Nothing
    excBook.Close False
    Set excBook = Nothing
    Set excApp = Nothing
    MsgBox "All done!"
End Sub

Author

Commented:
This works perfectly! Thanks!

Regard,

Nels
Top Expert 2010

Commented:
No problem.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial