Belirli Bir İş Unvanına Sahip Tüm Outlook Kişilerinden Hızlıca Bir Kişi Grubu Oluşturma

Belirli bir iş unvanına sahip kişilerle daha kolay iletişim kurabilmek için bu kişilerden hızlıca bir kişi grubu oluşturmak isteyebilirsiniz. Şimdi bu yazımızda sizlerle hızlı bir yöntem paylaşacağız.

Belirli bir iş unvanına sahip kişilere sık sık toplu e-postalar, görevler veya toplantı davetleri gönderiyorsanız, onlardan bir kişi grubu oluşturmanız çok daha uygun olacaktır. Genel olarak, standart şekilde, önce yeni bir kişi grubu oluşturmanız ve ardından kişileri birer birer üye olarak gruba eklemeniz gerekir. Biraz sıkıntılı. Bu nedenle, aşağıda, size onu elde etmenin çok daha hızlı bir yolunu öğreteceğiz.

Belirli Bir İş Unvanına Sahip Tüm Kişilerden Bir Kişi Grubu Oluşturun

1. İlk olarak, Kişiler klasöründe belirli iş unvanına sahip bir kişi seçin.
2. Ardından, Outlook VBA düzenleyicisine erişmek için “Alt + F11” tuşlarına basın.
3. Ardından, aşağıdaki VBA kodunu boş bir modüle veya projeye kopyalayın.

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. Bundan sonra, imleci ilk alt programa getirin.
5. Son olarak, bu makroyu çalıştırmak için “F5” tuşuna basın.
6. Makro tamamlandığında, yeni bir kişi grubu görüntülenecektir. Adım 1'de seçilen kişiyle aynı iş unvanına sahip tüm kişileri içerir.

Outlook Verilerini Etkili Bir Şekilde Koruyun

Outlook zengin özelliklere sahip olmasına rağmen, savunmasız olduğu gerçeğinden kurtulamaz. Bu nedenle, değerli Outlook verilerinizi kaybetmek istemiyorsanız, onu korumak için çaba göstermelisiniz. Örneğin, Outlook verileri için düzenli aralıklarla yedekleme yapmanız gerekir. Ayrıca, uygun fiyatlıysa, aşağıdaki gibi son teknoloji bir PST onarım aracına sahip olmanız önerilir. DataNumen Outlook Repairolabilir PST'yi onar veriler bir çırpıda.

Yazar Tanıtımı:

Shirley Zhang, bir veri kurtarma uzmanıdır. DataNumendahil olmak üzere veri kurtarma teknolojilerinde dünya lideri olan , Inc. bozuk sql ve görünüm onarım yazılım ürünleri. Daha fazla bilgi için ziyaret edin www.datanumen.com