Convert Distribution List of Contacts to Single Contacts

[LMS]

I read the following to simply select a distribution list I received, and then run this macro that creates a contact for each one in the distribution list.....but it saves all the contacts to the Contact folder...so can I change it to save them to a subfolder under the Contact folder?

Sub CreateContactsfromDL()

Dim o_list As Object

Dim objContact As outlook.contactItem

' set your category here.

t_cat = "From DL"

' Current object and should be the distributionlist

Set o_list = GetCurrentItem()

For i = 1 To o_list.MemberCount

' Create separate contacts

Set objContact = Application.CreateItem(olContactItem)

With objContact
.Email1Address = o_list.GetMember(i).Address
.FullName = o_list.GetMember(i)
.Categories = t_cat
.Save

End With

Next

Set objContact = Nothing

Set o_list = Nothing

End Sub

Function GetCurrentItem() As Object
Dim objApp As outlook.Application

Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.currentItem
End Select

Set objApp = Nothing

End Function

 

[Diane Poremsky]

This line: Set objContact = Application.CreateItem(olContactItem) uses the default folder. You need to set the folder then use .Add to add to that folder.

Replace the set objcontact line in your code with the two Set lines below and the dim at the top of the macro.

Dim Items As Outlook.Items

Set Items = Session.GetDefaultFolder(olFolderContacts).Folders("subfolder").Items

Set objContact = Items.Add(olContactItem)

- - - Updated - - -

This line: Set objContact = Application.CreateItem(olContactItem) uses the default folder. You need to set the folder then use .Add to add to that folder.






Replace the set objcontact line in your code with the two Set lines below and the dim at the top of the macro.




Dim Items As Outlook.Items




Set Items = Session.GetDefaultFolder(olFolderContacts).Folders("subfolder").Items


Set objContact = Items.Add(olContactItem)

 

[LMS]

Thanks much as usual....it worked when I used a distribution list of 5 emails....but when I used for a distribution list of 400 emails, it only creates one contact which is the first contact in the distribution list....anything to change please?

 

[Forum Admin]

The number of members shouldn't matter - 5 or 400. It sounds like its erroring and exiting. Try commenting out the on error resume next line in the function and see what happens.

 

[LMS]

How do I do what you said to do...as I don't know what this means: Try commenting out the on error resume next line in the function and see what happens

 

[Diane Poremsky]

change

On Error Resume Next
to
' On Error Resume Next

to comment it out. This will prevent the macro from going to the next line when it hits an error. Because its in the function, it may not show what line its exiting on, but it should stop, so we'll know there is a problem.

- - - Updated - - -

change


On Error Resume Next



to



' On Error Resume Next




to comment it out. This will prevent the macro from going to the next line when it hits an error. Because its in the function, it may not show what line its exiting on, but it should stop, so we'll know there is a problem.

 

[LMS]

I did it and no error shows up and nothing is colored