如何在Outlook中根据特定域名导出邮件地址？

Author: Xiaoyang Last Modified: 2025-05-07

如果您想从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