0
respostas

Buscar informações do Global Address List do Outlook, buscando por parâmetro

Olá a todos, gostaria ajuda dos senhores de resolver um desafio estou tentando buscar dados dos membros do Global Address List, do Outlook, queria formar a tabela lista de cada um com as categorias em localização avançada, Nome, Cargo, Empresa, ... , Departamento, esse primeiro código busca de todos os membros, e de forma específica queria salvar em uma planilha das informações de parte dessas informações, com propriedades de nome, empresa, departamento, email. Tentei buscar com alguma função atribuída ao parâmetro que possa formar os dados em uma planilha (ou buscar diretamente), e por os dados em uma planilha, e copiar para o campo do email e encaminhar para os destinatários, seria essa a dificuldade maior. Depois trazer os aniversariantes do dia, da planilha para o email com aquele modelo do RangetoHtml do Ron de Bruin. A dificuldade maior seria essa, de formar a tabela com os parametros e não buscar as informações após a tabela estiver concluída (em razão da quantidade de informações), em vista que esse código abaixo busca as informações.. agradeço, obrigado

Sub GetAllGALMembers()

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
  objMail.Body = objMail.Body & strName & vbTab & " (" & strAlias & ") " & vbTab & strAddress & vbTab & strPhone & vbTab & strDepartment & vbCrLf
  End If
  objMail.Display
Next i

objMail.Display

End Sub