Список управляемых CRM писем из Outlook в Excel

Question

Я получаю список писем в Excel из outlook. Мой код VBA работает, но я хотел бы включить его в код, если разговор контролируется (кнопка «Отслеживать» - CRM). Смотрите изображение ниже:

Пример кнопки отслеживания на электронной почте outlook

Знаете ли вы, какие почтовые свойства мне нужно использовать для получения информации об отслеживании разговоров?

Библиотека: https://docs.microsoft.com/en-us/dotnet/api/microsoft.office.interop.outlook.mailitem?redirectedfrom=MSDN&view=outlook-pia#properties_

Вот код, который я сейчас запускаю:

Sub Emails_Outlook()
'Carregar e-mails do outlook para o excel
Dim appOutlook As Object
Dim olNS As Object
Dim olFolder As Object
Dim olItem As Object
Dim r As Long
Dim Ws As Worksheet
Dim LstObj As ListObject
Dim rngDB As Range, n As Integer

On Error Resume Next
Set appOutlook = GetObject(, "Outlook.Application")
If appOutlook Is Nothing Then
Set appOutlook = CreateObject("Outlook.Application")
End If
On Error GoTo 0
Set olNS = appOutlook.GetNamespace("MAPI")
'Abaixo preencha o nome do arquivo de dados PST e a pasta.
'Neste caso o arquivo é Douglas Godoy e a pasta Caixa de Entrada.
Set olFolder = olNS.Folders("vaz.felipe@outlook.com.br").Folders("Caixa de Entrada").Folders("Teste")
Cells.Delete
r = 3
'Cria um array montando o título das colunas no arquivo.
Range("A3:E3") = Array("Título", "Quem enviou", "Nome de quem enviou", "Para", "Data e Hora")
For Each olItem In olFolder.Items
If TypeName(olItem) = "MailItem" Then
r = r + 1
Cells(r, "A") = olItem.Subject 'Assunto do e-mail
Cells(r, "B") = olItem.SenderEmailAddress 'E-mail do remetente
Cells(r, "C") = olItem.Sender 'Nome do remetente
Cells(r, "D") = olItem.To 'E-mail do destinatário
Cells(r, "E") = olItem.ReceivedTime 'Data/Hora de recebimento

'Cells(r, "E") = olItem.Attachments.Count 'Número de anexos
'Cells(r, "F") = olItem.Size 'Tamanho da mensagem em bytes
'Cells(r, "G") = olMail.LastModificationTime 'Última modificação
'Cells(r, "H") = olMail.Categories 'Categoria
'Cells(r, "I") = olMail.SenderName 'Nome do remetente
'Cells(r, "J") = olMail.FlagRequest 'Acompanhamento
'Cells(r, "K") = olItem.Body 'Tome cuidado ao utilizar pois carrega os dados do corpo do email
Application.StatusBar = r
End If
Next olItem

For Each Ws In Worksheets
        With Ws
            Set rngDB = .Range("a3").CurrentRegion
            For Each LstObj In Ws.ListObjects
                LstObj.Unlist
            Next
            If WorksheetFunction.CountA(rngDB) > 0 Then
                n = n + 1
                Set LstObj = .ListObjects.Add(xlSrcRange, rngDB, , xlYes)
                With LstObj

                    .Name = "AtendimentoPresencial" '& n
                    .TableStyle = "TableStyleLight8"
                End With
            End If
        End With
    Next Ws

Columns.AutoFit
End Sub