Как показать список адресов электронной почты из глобального списка в активную ячейку в Excel? - PullRequest
0 голосов
/ 02 марта 2020

Привет! Я использую SelectNamesDialog для своего листа Excel. Мой код может быть запущен, но он не извлекает имя электронной почты. Это мой вывод.

This's my output.

Но мне нужен этот вывод.

I need this E-mail Information.

Как это:

I need output like this:

Это мой код:

Sub SetContactsFolderAsInitialAddressList()
Dim oMsg As Outlook.MailItem
Set oMsg = Outlook.Application.CreateItem(olMailItem)
Dim oDialog As Outlook.SelectNamesDialog
Set oDialog = Outlook.Application.Session.GetSelectNamesDialog
Dim oAL As Outlook.AddressList
Dim oContacts As Outlook.Folder
Dim cEI As String
Dim c As Outlook.AddressEntry
Dim olRecipient As Outlook.Recipient
Set oContacts = _
Outlook.Application.Session.GetDefaultFolder(olFolderContacts)
Outlook.Application.ActiveWindow.Activate
On Error GoTo HandleError
For Each oAL In Outlook.Application.Session.AddressLists
If oAL.AddressListType = olOutlookAddressList Then
If oAL.GetContactsFolder.EntryID = _
oContacts.EntryID Then
Exit For
End If
End If
Next
With oDialog
.Caption = "Select Customer Contact"
.ToLabel = "Customer C&ontact"
.NumberOfRecipientSelectors = olShowTo
.InitialAddressList = oAL
.AllowMultipleSelection = False
.Recipients = oMsg.Recipients
If .Display Then
'Recipients Resolved
For Each olRecipient In .Recipients
cEI = olRecipient.EntryID 'entry id of selected contact
Set c = Outlook.Application.Session.GetAddressEntryFromID(cEI)
Worksheets("Sheet1").Range("A1") = c.GetContact.Email1Address
Worksheets("Sheet1").Range("A2") = c.GetContact.FirstName
Worksheets("Sheet1").Range("A3") = c.GetContact.LastName
Worksheets("Sheet1").Range("A4") = c.GetContact.BusinessFaxNumber
Worksheets("Sheet1").Range("A5") = c.GetContact.BusinessTelephoneNumber
Worksheets("Sheet1").Range("A6") = c.GetContact.BusinessAddressStreet
Worksheets("Sheet1").Range("A7") = c.GetContact.BusinessAddressCity
Worksheets("Sheet1").Range("A8") = c.GetContact.BusinessAddressState
Worksheets("Sheet1").Range("A9") = c.GetContact.BusinessAddressPostalCode
Worksheets("Sheet1").Range("A10") = c.GetContact.CompanyName
Worksheets("Sheet1").Range("A11") = c.GetContact.Address
Next
End If
End With
HandleError:
AppActivate "Microsoft Excel"
Exit Sub
AppActivate "Microsoft Excel"
End Sub

Пожалуйста, сообщите мне, какой код ошибки я должен исправить? Извините для плохого английского sh skill.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...