Как извлечь 'to'/'to' адрес из заголовка в Outlook 2007 + с помощью VBA Script

Question

Я использую сценарий BlueDevilFan VBA, чтобы показать мне заголовки интернета из электронной почты в Outlook 2013. Я пытаюсь изменить VBA так что это только выводит «на» или «для» адрес и отбрасывает все другие тексты,

Ниже приведен сценарий VBA:

Sub ViewInternetHeader() 
    Dim olItem As Outlook.MailItem, olMsg As Outlook.MailItem 
    Dim strheader As String 

    For Each olItem In Application.ActiveExplorer.Selection 
     strheader = GetInetHeaders(olItem) 

     Set olMsg = Application.CreateItem(olMailItem) 
     With olMsg 
      .BodyFormat = olFormatPlain 
      .Body = strheader 
      .Display 
     End With 
    Next 
    Set olMsg = Nothing 
End Sub 

Function GetInetHeaders(olkMsg As Outlook.MailItem) As String 
    ' Purpose: Returns the internet headers of a message.' 
    ' Written: 4/28/2009' 
    ' Author: BlueDevilFan' 
    ' http://techniclee.wordpress.com/ 
    ' Outlook: 2007' 
    Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E" 
    Dim olkPA As Outlook.PropertyAccessor 
    Set olkPA = olkMsg.PropertyAccessor 
    GetInetHeaders = olkPA.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS) 
    Set olkPA = Nothing 
End Function 

Я пытался что-то, как я хотел бы использовать в слова, чтобы найти и удалить определенный контент, но не может заставить его работать в Outlook!

Sub CleanUp() 
With Selection 
.HomeKey Unit:=wdStory 
With .Find 
.ClearFormatting 
.Replacement.ClearFormatting 
.Text = "(\To: """)" 
.Replacement.Text = "" 
.Forward = True 
.Wrap = wdFindContinue 
.Format = False 
.MatchCase = False 
.MatchWholeWord = False 
.MatchAllWordForms = False 
.MatchSoundsLike = False 
.MatchWildcards = True 
.Execute Replace:=wdReplaceAll 
.Text = "(\To: """)" 
.Execute Replace:=wdReplaceAll 
End With 
End With 
End Sub 

Answer 1

вы можете просто очистить текст тела, а затем добавить к и от отправителя, т.е.

Sub ViewInternetHeader() 
    Dim olItem As Outlook.MailItem, olMsg As Outlook.MailItem 


    For Each olItem In Application.ActiveExplorer.Selection 


     Set olMsg = Application.CreateItem(olMailItem) 
     olMsg.BodyFormat = olFormatPlain 
     olMsg.Body = "" 
     olMsg.Body = olItem.To & Chr(13) & olItem.Sender 
     olMsg.Display 
    Next 
    Set olMsg = Nothing 
End Sub 

Answer 2

Зачем вам нужно, чтобы извлечь адреса из заголовков? Просто перебрать все получатель в MailItem.Recipients коллекции и если Recipient.Type = olTo, читать Recipient.Address недвижимости/