Получение данных из Outlook в Excel. Открытие писем и ответ всем

Sub ПолучитьДанныеОтправленныеПисьма()
 
    Dim olApp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olMail As Outlook.MailItem
    Dim xlWorksheet As Excel.Worksheet
    Dim iRow As Integer
 
    'Создать объект приложения Outlook
    Set olApp = New Outlook.Application
 
    'Создать объект пространства имен
    Set olNs = olApp.GetNamespace("MAPI")
 
    'Получить папку "Отправленные" в текущем ящике
    Set olFolder = olNs.GetDefaultFolder(olFolderSentMail).Folders("Контроль")
 
    'Установить активный лист в книге Excel
    Set xlWorksheet = ActiveWorkbook.ActiveSheet
 
    'Пройти по каждому письму в папке "Отправленные"
    For Each olMail In olFolder.Items
        'Проверить, является ли письмо объектом MailItem и было ли оно отправлено
        If TypeOf olMail Is Outlook.MailItem And olMail.Sent Then
            'Добавить данные в лист Excel
            iRow = xlWorksheet.Cells(xlWorksheet.Rows.Count, 1).End(xlUp).row + 1
            xlWorksheet.Cells(iRow, 1).Value = olMail.Subject
            xlWorksheet.Cells(iRow, 2).Value = olMail.SentOn
            xlWorksheet.Hyperlinks.Add Anchor:=xlWorksheet.Cells(iRow, 3), Address:="outlook:/" & olMail.EntryID, ScreenTip:="Открыть письмо", TextToDisplay:="Открыть письмо"
            xlWorksheet.Hyperlinks.Add Anchor:=xlWorksheet.Cells(iRow, 4), Address:="outlook:/" & olMail.EntryID & "/action=replyall", TextToDisplay:="Ответить всем с вложениями"
 
        End If
 
    Next olMail
 
    'Сохранить и закрыть книгу Excel
    'ActiveWorkbook.Save
    'ActiveWorkbook.Close
 
    'Освободить объекты из памяти
    Set olMail = Nothing
    Set olFolder = Nothing
    Set olNs = Nothing
    Set olApp = Nothing
    Set xlWorksheet = Nothing
 
End Sub