2方法將Outlook聯繫人組的所有成員導出到Excel

Outlook解決方案 2025 年 9 月 29 日

有時，您可能希望導出某個Outlook聯繫人組中的成員。因此，本文將向您分享2種將組成員提取到Excel的方法。

Outlook提供了本機功能，允許您導出某個聯繫人文件夾的所有聯繫人。但是，它不允許您導出聯繫人組，更不用說提取聯繫人組中的成員了。因此，如果要提取所選聯繫人組的成員，則需要付出更多努力。您可以參考以下兩個技巧。

方法1：通過另存為提取組成員

首先，啟動Outlook。
然後找到並選擇您需要提取其成員的聯繫人組。
接下來，您應該轉到“文件”菜單，然後單擊“另存為”。
隨後，在彈出的“另存為”對話框中，選擇要保存的目標文件夾，然後從“另存為類型”下拉列表中選擇“僅文本”。
然後點擊“保存”。
之後，打開Excel並創建一個新的Excel文件。
之後，您應該轉到“文件”，然後單擊“打開”按鈕。
在隨後的“打開”對話框中，您應該首先訪問剛才保存聯繫人組的文件夾。
然後單擊“文件名”行中的第二個框，然後從其下拉列表中選擇“所有文件”。
此後，將文本文件放在聯繫人組的文本文件上，然後單擊“打開”。
在彈出的“文本導入嚮導”對話框中，確保已選擇“定界”，然後單擊“完成”按鈕。
最後，您將獲得成員，如以下屏幕截圖所示：

方法2：通過Outlook VBA提取組成員

首先，在Outlook中按“ Alt + F11”鍵按鈕。
然後在VBA編輯器窗口中打開一個新模塊。
隨後，將以下VBA代碼複製到其中。

Sub ExtractContactGroupMembersToExcel()
    Dim objContactGroup As Outlook.DistListItem
    Dim objMember As Outlook.recipient
    Dim objExcelApp As Excel.Application
    Dim objExcelWorkBook As Excel.Workbook
    Dim objExcelWorkSheet As Excel.Worksheet
    Dim i As Integer
    Dim nRow As Integer
    Dim strPath As String
    Dim strFilename As String
 
    Select Case Application.ActiveWindow.Class
           Case olExplorer
                Set objContactGroup = Application.ActiveExplorer.Selection(1)
           Case olInspector
                Set objContactGroup = Application.ActiveInspector.CurrentItem
    End Select
 
    If TypeOf objContactGroup Is DistListItem Then
       'Create a new Excel workbook
       Set objExcelApp = CreateObject("Excel.Application")
       Set objExcelWorkBook = objExcelApp.Workbooks.Add
       Set objExcelWorkSheet = objExcelWorkBook.Worksheets(1)
 
       'Set the two column headers
       objExcelWorkSheet.Cells(1, 1) = "Contact Name"
       objExcelWorkSheet.Cells(1, 2) = "Email Address"

       nRow = 2
 
       'Extract the contact group members' names and email addresses
       For i = 1 To objContactGroup.MemberCount
           Set objMember = objContactGroup.GetMember(i)
           objExcelWorkSheet.Cells(nRow, 1) = objMember.Name
           objExcelWorkSheet.Cells(nRow, 2) = objMember.Address
           nRow = nRow + 1
       Next
 
       'AutoFit the columns in the new Excel worksheet
       objExcelWorkSheet.Columns("A:B").AutoFit
 
       'Change the strPath to your actual case
       strPath = "C:\Contact Groups\"
       strFilename = strPath & objContactGroup.DLName & ".xlsx"
 
       'Save the Excel workbook
       objExcelWorkBook.Close True, strFilename
 
       'Notify you of the export complete
       MsgBox ("Export Complete!")
    End If
End Sub