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