如何在列表視圖中按域快速對 Outlook 聯繫人進行分組

Outlook解決方案 2025 年 9 月 29 日

Outlook 默認情況下不提供“域”字段。因此，如果您希望按域對聯繫人進行分組，則必須首先創建這樣的字段。現在，本文將向您展示如何立即實現它。

您可以按任何可用字段對 Outlook 聯繫人進行分組，例如公司、顏色類別、職位等。但是，沒有默認的“域”字段。因此，您無法輕鬆地按域對聯繫人進行分組。但通過以下方式，你仍然可以快速實現。

在列表視圖中按域對 Outlook 聯繫人進行分組

首先，啟動 Outlook 程式。
然後，在 Outlook 窗口中，切換到“開發人員”選項卡並單擊“Visual Basic”按鈕。
接下來，您將可以訪問 Outlook VBA 編輯器，其中需要打開未使用的模塊。
隨後，將以下VBA代碼複製到該模塊中。

Sub DisplayDomain()
    Dim objCurrentFolder As Outlook.Folder
    Dim objItem As Object
    Dim objContact As Outlook.ContactItem
    Dim objProperties As Outlook.UserProperties
    Dim objProperty As Outlook.UserProperty
    Dim strPropertyName As String
    Dim strMainEmailAddress, strDomain As String
 
    Set objCurrentFolder = Outlook.Application.ActiveExplorer.CurrentFolder
 
    If objCurrentFolder.DefaultItemType = olContactItem Then
       If objCurrentFolder.Items.count > 0 Then
 
          For Each objItem In objCurrentFolder.Items
              If TypeOf objItem Is ContactItem Then
 
                 Set objContact = objItem
                 Set objProperties = objContact.UserProperties
  
                 strPropertyName = "Domain"
 
                 Set objProperty = objProperties.Find(strPropertyName, True)
                 If objProperty Is Nothing Then
                    Set objProperty = objProperties.Add(strPropertyName, olText, True)
                 End If
 
                 strMainEmailAddress = objContact.Email1Address
                 strDomain = Right(strMainEmailAddress, Len(strMainEmailAddress) - InStr(1, strMainEmailAddress, "@"))
 
                 objProperty.value = strDomain
                 objContact.Save
              End If
          Next
       Else
          MsgBox "No Items in This Contacts Folder!", vbExclamation
       End If
    Else
      MsgBox "Please access a Contacts folder!", vbExclamation
    End If
End Sub