Microsoft Outlook does not have a feature that allows you to paste multiple e-mail addresses from the clipboard and make a distribution list. Usually, this process is done by manually writing one address after another in the distribution list editor or by choosing the individual recipients.
Sub Creating_Distribution_Lists() Dim Message$, Name_of_the_list$, Addresses$, x& Message = "Paste e-mail addresses separated by '';''" Addresses = Trim(InputBox(Message, "Creating Distribution Lists")) If Len(Addresses) > 0 Then On Error GoTo error If InStr(1, Addresses, ";") > 0 Then Message = "Provide a name for the new Distribution List." & vbCr _ & "All correct addresses will be included in the list." Name_of_the_list = Trim(InputBox(Message, "Creating Distribution Lists ")) Name_of_the_list = Replace(Name_of_the_list, ";", " ") Name_of_the_list = Replace(Name_of_the_list, "(", vbNullString) Name_of_the_list = Replace(Name_of_the_list, ")", vbNullString) If Len(Name_of_the_list) = 0 Then GoTo no_name_given Dim oContactFolder As MAPIFolder Dim oDistList As DistListItem Dim oMailItem As MailItem Dim oRecipients As Recipients Dim oRecipient As Recipient oContactFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts) oDistList = oContactFolder.Items.Add(olDistributionListItem) With oDistList .DLName = Name_of_the_list .Save() End With oDistList = oContactFolder.Items(Name_of_the_list) oMailItem = Application.CreateItem(olMailItem) oRecipients = oMailItem.Recipients Dim temp() As String, abc& abc = 0 temp() = Split(Left$(Addresses, Len(Addresses) - 1), ";") While (abc <= UBound(temp())) If temp(abc) Like "*@*.*" Then oRecipients.Add(temp(abc)) x = x + 1 End If abc = abc + 1 End While oRecipients.ResolveAll() If x > 0 Then With oDistList .AddMembers(oRecipients) .Save() '<-if you want to save .Display(0) '<-If you want to display End With Else oDistList.Delete() End If oDistList = Nothing oMailItem = Nothing oRecipients = Nothing Elselack_of_at_least_2: MsgBox("Distribution List has not been created." & vbCr _ & "To create a Distribution List you need to paste " & vbCr _ & "at least 2 e-mail addresses separated with '';''.", vbExclamation, " Information about error ") End If Else GoTo lack_of_at_least_2 End If Exit Subno_name_given: MsgBox("Distribution List has not been created." & vbCr _ & "To create a Distribution List you need to" & vbCr _ & "give a name for the group of recipients.", vbExclamation, " information about error ") Exit Sub error: MsgBox("Procedure error: ''Creating_Distribution_Lists''" & vbCr _ & Err.Number & vbCr _ & Err.Description, vbExclamation, "Information about error ")End Sub
Maheshkumar S Tiwari edited Original. Comment: Added tags
Peter Geelen - MSFT edited Revision 2. Comment: removed TOU and copyright info, see MS TOU.