Как быстро создать группу контактов из всех контактов Outlook с определенной должностью

Чтобы упростить общение с контактами с определенной должностью, вы можете быстро создать группу контактов из этих контактов. Теперь, в этой статье, мы поделимся с вами быстрым методом.

Если вы часто отправляете электронные письма, задачи или приглашения на встречи контактам, имеющим определенную должность, будет намного удобнее, если вы создадите из них группу контактов. Как правило, стандартным способом вам нужно сначала создать новую группу контактов, а затем добавить контакты в группу в качестве участников по одному. Это немного хлопотно. Поэтому в дальнейшем мы научим вас гораздо более быстрому способу его получения.

Создайте группу контактов из всех контактов с определенной должностью

1. Сначала в папке «Контакты» выберите контакт с определенной должностью.
2. Затем нажмите «Alt + F11», чтобы открыть редактор Outlook VBA.
3. Затем скопируйте следующий код VBA в пустой модуль или проект.

Dim objContact As Outlook.ContactItem
Dim strJobTitle As String
Dim objNewGroup As Outlook.DistListItem
Dim objTempMail As Outlook.MailItem

Sub CreateContactGroupfromContactsSameJobTitle()
    Dim objStore As Outlook.Store
    Dim objOutlookFile As Outlook.Folder
    Dim objFolder As Outlook.Folder
 
    Set objContact = Outlook.Application.ActiveExplorer.Selection(1)
    strJobTitle = objContact.JobTitle
 
    Set objNewGroup = Outlook.Application.CreateItem(olDistributionListItem)
    Set objTempMail = Outlook.Application.CreateItem(olMailItem)
 
    'Process all Contacts folders
    For Each objStore In Outlook.Application.Session.Stores
        Set objOutlookFile = objStore.GetRootFolder
        For Each objFolder In objOutlookFile.Folders
            If objFolder.DefaultItemType = olContactItem Then
               Call ProcessContactsFolders(objFolder)
            End If
        Next
    Next
 
    objNewGroup.AddMembers objTempMail.Recipients
    objNewGroup.Display
End Sub

Sub ProcessContactsFolders(ByVal objCurFolder As Outlook.Folder)
    Dim objItem As Object
    Dim objSubfolder As Outlook.Folder
 
    For Each objItem In objCurFolder.Items
        If objItem.Class = olContact Then
           If objItem.JobTitle = strJobTitle Then
              'Add the contact having the specific job title to the new group
              objTempMail.Recipients.Add (objItem.Email1Address)
              objTempMail.Recipients.ResolveAll
           End If
        End If
    Next
 
    'Process all subfolders recursively
    If objCurFolder.Folders.Count > 0 Then
       For Each objSubfolder In objCurFolder.Folders
           Call ProcessContactsFolders(objSubfolder)
       Next
    End If
End Sub

4. После этого переместите курсор в первую подпрограмму.
5. Наконец, нажмите кнопку «F5», чтобы запустить этот макрос.
6. Когда макрос завершится, появится новая группа контактов. Он содержит все контакты с той же должностью, что и выбранный контакт на шаге 1.

Эффективно защищайте данные Outlook

Хотя Outlook многофункционален, он не может избавиться от того факта, что он уязвим. Итак, если вы не хотите потерять свои драгоценные данные Outlook, вы должны приложить усилия для их защиты. Например, вам необходимо регулярно делать резервные копии данных Outlook. Кроме того, если это возможно, рекомендуется иметь передовой инструмент для восстановления PST, такой как DataNumen Outlook Repair, Которые могут восстановить PST данные в один миг.

Об авторе:

Ширли Чжан — эксперт по восстановлению данных в DataNumen, Inc., которая является мировым лидером в области технологий восстановления данных, включая поврежденный sql и программные продукты для ремонта Outlook. Для получения дополнительной информации посетите www.datanumen.com