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

作者：晓阳最后修改时间：2022-10-19

如果您想从 Outlook 中的所有联系人中导出具有特定域的电子邮件地址，请阅读本教程，该教程将帮助您应用 VBA 代码将特定域中的所有电子邮件地址提取到文本文件中，如下图所示.

使用 VBA 代码在 Outlook 中基于特定域导出电子邮件地址

要从所有联系人中提取具有特定域的所有电子邮件地址，请执行以下步骤：

1. 创建一个新的文本文件并为其命名，请参见屏幕截图：

2。按住 ALT + F11 键打开 Microsoft Visual Basic应用程序 窗口。

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" 对你自己。