MyTetra Share
Делитесь знаниями!
Как выгрузить электронные адреса получателей из Outlook в Excel
Время создания: 22.04.2020 13:36
Текстовые метки: VBA_Outlook
Раздел: !Закладки - VBA - Outlook

Для получения адреса вместо  Item1.To используйте Item1.Recipients(Item1.To).Address. Но сначала проверить, что Item1.To <> "" , конечно. В начале кода желательно объявить переменную Dim Item1 As Object


Большое спасибо, ZVI !   Я тоже не обратил внимания на Recipients. Теперь код получается такой (работает прекрасно!).


Sub main2() 'запускаем эту процедуру в Excel

 
    Dim olApp   As Object 'Outlook.Application
    Dim fldr    As Object 'Outlook.Folder
    Dim Item1    As Object 'Сообщение
    Dim Recipient1    As Object 'Адресаты
     
    Set olApp = CreateObject("Outlook.Application")
     
'    'обрабатываем папку Контакты
'    PrintInCell ("Папка Контакты")
'    Set fldr = olApp.Session.GetDefaultFolder(10)  '10 = olFolderContacts
'    For Each Item1 In fldr.Items
'        'Выписываем адресатов
'        str1 = Item1.Email1Address
'        PrintInCell (str1)
'        ActiveCell.Offset(-1, 1).Range("A1").Select
'        str1 = Item1.Subject
'        PrintInCell (str1)
'        ActiveCell.Offset(0, -1).Range("A1").Select
'    Next
'    PrintInCell ("")
'    PrintInCell ("")
     
    'обрабатываем папку Отправленные
    PrintInCell ("Адресаты из папки Отправленные")
    Set fldr = olApp.Session.GetDefaultFolder(5)  '5 = olFolderSentMail
    'Call processFolder(fldr)
    For Each Item1 In fldr.Items
        'Выписываем адресатов
        If Item1.Class = 43 Then  'сообщения -  Class = 43
            If Item1.Recipients.Count > 0 Then
                For Each Recipient1 In Item1.Recipients
                    str1 = Recipient1.Address
                    PrintInCell (str1)
                Next
            End If
        End If
    Next
 
End Sub
 
 
Sub PrintInCell(val1 As String)
     'Пользовательская функция записи
    ActiveCell.Value = val1
    ActiveCell.Offset(1, 0).Range("A1").Select
End Sub
Так же в этом разделе:
 
MyTetra Share v.0.53
Яндекс индекс цитирования