Для получения адреса вместо  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