Como exportar endereços de email com base em domínio específico no Outlook?

Se você deseja exportar os endereços de e-mail com um domínio específico de todos os contatos em seu Outlook, leia este tutorial que o ajudará a aplicar um código VBA para extrair todos os endereços de e-mail em um domínio específico para um arquivo de texto conforme a captura de tela abaixo mostrada .

Exporte endereços de email com base em domínio específico no Outlook com código VBA

Para extrair todos os endereços de e-mail com um domínio específico de todos os contatos, siga as etapas a seguir:

1. Crie um novo arquivo de texto e dê um nome a ele, veja a captura de tela:

2. Segure o ALT + F11 chaves para abrir o Microsoft Visual Basic para Aplicações janela.

3. Então clique inserção > Móduloe cole o código a seguir na janela do módulo.

Código VBA: Exporte endereços de e-mail com base em domínio específico

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

Note: No código acima, altere o caminho do arquivo "C:\Users\skyyang\Desktop\Email Addresses com domínio específico.txt" para o seu próprio.

4. E então, pressione F5 chave para executar este código. Uma caixa de prompt é exibida, digite o domínio de e-mail no qual você deseja exportar os endereços de e-mail com base, veja a captura de tela:

5. Então clique OK botão e todos os endereços de e-mail no domínio específico são extraídos para o arquivo de texto de uma só vez, veja a captura de tela: