XL 2010 récupération de l'adresse mail du destinataire

Option Explicit
Dim ri As Long
Private Sub CommandButton1_Click()
  ri = 2
  Dim app As Outlook.Application
  Dim AppNs As Outlook.Namespace
  Dim AppFolder As Outlook.MAPIFolder  '  MAPIFolder
 
 
  Set app = New Outlook.Application
  Set AppNs = app.GetNamespace("MAPI")
  Set AppFolder = AppNs.Folders(1)
  Call ProcessFolder(AppFolder)
Set AppFolder = Nothing
  Set AppNs = Nothing
' app.Quit
  Set app = Nothing
End Sub
Sub ProcessFolder(AppFolder As Outlook.MAPIFolder)
    Dim email As Outlook.MailItem
    Dim AppSubFolder As Outlook.Folder
    For Each AppSubFolder In AppFolder.Folders
        Cells(ri, 1).Value = AppSubFolder.Name
        ri = ri + 1
        ProcessFolder AppSubFolder
    Next AppSubFolder
    On Error Resume Next
    For Each email In AppFolder.Items
        Cells(ri, 2).Value = email.ReceivedTime
        Cells(ri, 3).Value = email.SenderEmailAddress
        Cells(ri, 4).Value = email.To
        Cells(ri, 5).Value = email.CC
        Cells(ri, 6).Value = email.Subject
        If email.Attachments.Count > 0 Then
            Dim ci As Integer
            ci = 1
            Dim emailAttachement As Outlook.Attachment
            For Each emailAttachement In email.Attachments
                Cells(ri, 6 + ci).Value = emailAttachement.Filename
                ci = ci + 1
            Next emailAttachement
        End If
        ri = ri + 1
    Next
End Sub