從 Excel 文件中的聯繫人列表創建聯繫人組的 2 種方法

如果您想從 Excel 文件中的聯繫人列表創建 Outlook 聯繫人組，您可以使用本文介紹的 2 種方法。

一些用戶正在尋求一種從包含聯繫人列表的 Excel 文件快速創建 Outlook 聯繫人組的方法。 當然，您可以手動創建這樣的聯繫人組。 不過，有點麻煩。 因此，除了手動方法之外，這裡我們將額外介紹另一種使用VBA 的快速方法。

方法一：手動創建

1. 首先，打開Excel文件。
2. 然後選擇包含電子郵件地址的列。 或者，您也可以包括名稱列。
3. 接下來按“Ctrl + C”到所有選定的單元格。
4. 在那之後，小號tar您的Outlook程序。
5. 然後切換到“聯繫人”窗格並點擊“新建聯繫人組”按鈕。
6. 隨後，單擊“添加成員”->“來自 Outlook 聯繫人”
7. 稍後單擊“成員 ->”字段並按“Ctrl + V”鍵粘貼之前複製的聯繫人。
8. 點擊“確定”按鈕。
9. 然後為新聯繫人組指定一個名稱。
10. 最後點擊“Save & Close”保存該組。

方法二：通過Outlook VBA創建

1. 首先，在Outlook中按“ Alt + F11”鍵按鈕。
2. 然後打開一個新模塊。
3. 隨後，將以下代碼複製並粘貼到其中。

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

4. 之後，點擊工具欄中的“運行”圖標。
5. 馬上會出現一個新的聯繫人組，如下圖：

巧妙處理惱人的前景問題

如果您在 Outlook 中經常遇到各種錯誤，強烈建議您保持卓越可靠 Outlook恢復 附近的工具，例如 DataNumen Outlook Repair. 在這種情況下，您可以通過它及時處理煩人的問題。

作者簡介：

Shirley Zhang是的數據恢復專家 DataNumen，Inc.是數據恢復技術的全球領導者，包括 恢復SQL 和Outlook修復軟件產品。 欲了解更多信息，請訪問 萬維網。datanumen.COM