Buscar informações de um parâmetro de Global Address List

Bom dia, por favor no referido código está para capurar informações de usuários da Global Address List, no campo de email, para que seja capturada as informações de email dos usuários de um parâmetro apenas, departamento, por exemplo, e copiar no campo destinatários. Obrigado, bons estudos a todos

Sub GetAllGALMembers1()

Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olGAL As Outlook.AddressList
Dim olEntry As Outlook.AddressEntries
Dim olMember As Outlook.AddressEntry
Dim objMail As Outlook.MailItem

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olGAL = olNS.GetGlobalAddressList()

Set objMail = olApp.CreateItem(olMailItem)
objMail.Body = "Name" & vbTab & "Alias" & vbTab & "Email Address" & vbTab & "Business Phone" & vbTab & "Department" & vbCrLf
Set olEntry = olGAL.AddressEntries
On Error Resume Next
' loop through dist list and extract members
Dim i As Long
For i = 1 To olEntry.Count
  Set olMember = olEntry.Item(i)

  If olMember.AddressEntryUserType = olExchangeUserAddressEntry Then
  strName = olMember.Name
  strAlias = olMember.GetExchangeUser.Alias
  strAddress = olMember.GetExchangeUser.PrimarySmtpAddress
  strPhone = olMember.GetExchangeUser.BusinessTelephoneNumber
  strDepartment = olMember.GetExchangeUser.Department
  If ol.Member.GetExchangeUser.Department = "" Then
    Value = True
  End If

  objMail.Body = objMail.Body & strName & vbTab & " (" & strAlias & ") " & vbTab & strAddress & vbTab & strPhone & vbTab & strDepartment & vbCrLf
  End If
  objMail.Display
Next i

objMail.Display

End Sub