如何在 Outlook 中根據特定域名導出郵件地址？

Author: Xiaoyang Last Modified: 2025-05-12

如果您想從 Outlook 的所有聯絡人中導出具有特定域名的郵件地址，請閱讀本教程，它將幫助您應用 VBA 代碼來提取特定域名的所有郵件地址到文本文件中，如下方截圖所示。

doc-export-addresses-with-domain-1

使用 VBA 代碼在 Outlook 中根據特定域名導出郵件地址

要從所有聯絡人中提取具有特定域名的所有郵件地址，請按照以下步驟操作：

1. 創建一個新的文本文件並為其命名，參見截圖：

doc-export-addresses-with-domain-2

2. 按住「ALT + F11」鍵打開「Microsoft Visual Basic for Applications」窗口。

3. 然後，點擊「插入」>「模塊」，並將以下代碼粘貼到模塊窗口中。

「VBA 代碼：根據特定域名導出郵件地址」

Dim GDomain As String
Dim GFileSystem As Object
Dim GFilePath As String
Dim GFileObj As Object
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, _
  ByVal ipOperation As String, ByVal lpFile As String, _
  ByVal lpParameters As String, ByVal lpDirectory As String, _
  ByVal nShowCmd As Long) As Long

Sub ExportListOfEmailAddressesInSpecificDomain()
'Updateby ExtendOffice
Dim xStore As Store
Dim xFolder As Folder
On Error Resume Next
GDomain = InputBox("Enter domain(@***.com):", "Kutools for Outlook")
If Len(GDomain) <> 0 Then
  GFilePath = "C:\Users\skyyang\Desktop\Email Addresses with specific domain.txt" 'Specify the file path
  Set GFileSystem = CreateObject("Scripting.FileSystemObject")
  Set GFileObj = GFileSystem.CreateTextFile(GFilePath, True)
  For Each xStore In Application.Session.Stores
    For Each xFolder In xStore.GetRootFolder.Folders
      If xFolder.DefaultItemType = olContactItem Then
        Call ProcessFolders(xFolder)
      End If
    Next
  Next
  GFileObj.Close
  ShellExecute 0&, vbNullString, GFilePath, vbNullString, vbNullString, 1
End If
End Sub

Sub ProcessFolders(ByVal Fld As Outlook.Folder)
Dim xContactItems As Items
Dim I As Long
Dim xContact As ContactItem
Dim xSubFolder As Folder
On Error Resume Next
Set xContactItems = Fld.Items
For I = xContactItems.Count To 1 Step -1
  If xContactItems(I).Class = olContact Then
    Set xContact = xContactItems(I)
    If InStr(xContact.Email1Address, GDomain) > 0 Then
      GFileObj.WriteLine (xContact.Email1Address & vbCrLf)
    ElseIf InStr(xContact.Email2Address, GDomain) > 0 Then
      GFileObj.WriteLine (xContact.Email2Address & vbCrLf)
    ElseIf InStr(xContact.Email3Address, GDomain) > 0 Then
      GFileObj.WriteLine (xContact.Email3Address & vbCrLf)
    End If
  End If
Next
If Fld.Folders.Count > 0 Then
  For Each xSubFolder In Fld.Folders
    If xSubFolder.DefaultItemType = olContactItem Then
      Call ProcessFolders(xSubFolder)
    End If
  Next
End If
End Sub

注意：在上述代碼中，將文件路徑「C:\Users\skyyang\Desktop\Email Addresses with specific domain.txt」更改為您自己的路徑。

doc-export-addresses-with-domain-4