1. We have added a Gift Upgrades feature that allows you to gift an account upgrade to another member, just in time for the holiday season. You can see the gift option when going to the Account Upgrades screen, or on any user profile screen.
    Dismiss Notice

add contact list as an new contact group

Discussion in 'Computer Talk' started by Jaoden, Jun 13, 2017.

  1. Jaoden

    Jaoden Chieftain

    Joined:
    Jun 13, 2017
    Messages:
    2
    Hello,

    I just get a contact list in a excel file. And I want to add them all as an new contact group in my Outlook 2010. Do I have to add them one by one manually? Any other easy way to do that? Any help will be appreciated.
     
  2. Naesk

    Naesk Chieftain

    Joined:
    Jun 18, 2017
    Messages:
    1
    Gender:
    Female
    Hi, Jaoden

    The simple way may be using VBA. Here is a macro you can try

    Code:
    Sub CreateContactGroupfromExcel()
        Dim objContactsFolder As Outlook.Folder
        Dim objContact As Outlook.ContactItem
        Dim objContactGroup As Outlook.DistListItem
        Dim objExcelApp As New Excel.Application
        Dim objExcelWorkbook As Excel.Workbook
        Dim objExcelWorksheet As Excel.Worksheet
        Dim nLastRow As Integer
        Dim nCurrentRow As Integer
        Dim objNameCell As Excel.Range
        Dim objEmailCell As Excel.Range
        Dim strName As String
        Dim strEmail As String
        Dim objTempMail As Outlook.MailItem
        Dim objRecipients As Outlook.Recipients
    
        Set objContactsFolder = Outlook.Application.Session.GetDefaultFolder(olFolderContacts)
        Set objContactGroup = Outlook.Application.CreateItem(olDistributionListItem)
        'You can change the contact group name
        objContactGroup.DLName = "Group Name"
     
        Set objExcelApp = CreateObject("Excel.Application")
        'You should change the path to your own Excel file
        Set objExcelWorkbook = objExcelApp.Workbooks.Open("E:\Contacts.xlsx")
        Set objExcelWorksheet = objExcelWorkbook.Sheets(1)
        objExcelWorksheet.Activate
     
        nLastRow = objExcelWorksheet.UsedRange.Rows.Count
        'The "A2" varies with the first contact's name cell in your own Excel file
        Set objNameCell = objExcelApp.Range("A2")
        objNameCell.Select
     
        While nCurrentRow <= nLastRow
              nCurrentRow = objNameCell.Row
     
              strName = objNameCell.Value
     
              If strName = "" Then
                 GoTo NextRow
              End If
     
              Set objEmailCell = objExcelApp.ActiveCell.Offset(0, 1)
              strEmail = objEmailCell.Value
     
              Set objContact = objContactsFolder.Items.Find("[FullName] = '" & strName & "'")
     
              'If there is no such a contact, create it.
              If objContact Is Nothing Then
                 Set objContact = Outlook.Application.CreateItem(olContactItem)
                 With objContact
                      .FullName = strName
                      .Email1Address = strEmail
                      .Save
                 End With
              End If
     
              'Add the contacts to the new contact group
              Set objTempMail = Application.CreateItem(olMailItem)
              objTempMail.Recipients.Add (strName)
              Set objRecipients = objTempMail.Recipients
              objContactGroup.AddMembers objRecipients
    
        NextRow:
              Set objNameCell = objExcelApp.ActiveCell.Offset(1, 0)
              objNameCell.Select
        Wend
     
        'Use "objContactGroup.Save" to straightly save it
        objContactGroup.Display
        objTempMail.Close olDiscard
        objExcelApp.Quit
    End Sub
    Here is the article, you can find more details

    https://www.datanumen.com/blogs/2-methods-create-contact-group-list-contacts-excel-file/

    Hope it helps
     
  3. Jaoden

    Jaoden Chieftain

    Joined:
    Jun 13, 2017
    Messages:
    2
    Thanks a lot! It helps!
     

Share This Page