Listar e-mails numa tabela do Access

As vezes a gente precisa de coisas diferentes e a necessidade acaba gerando códigos novos: como listar os e-mails numa tabela (com pouca adaptação, poderia ser uma planilha do Excel).

;-)

Sub Listar_emails_Access()
   
    Dim rst                 As New ADODB.Recordset
    Dim cnn                 As New ADODB.Connection
   
    Dim contador_itens      As Integer
    Dim nms                 As Outlook.NameSpace
    Dim fld                 As Outlook.MAPIFolder
    Dim itm                 As Object

    Set nms = Application.GetNamespace("MAPI")
    Set fld = nms.PickFolder
   
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & "C:Base.accdb"
   
    rst.Open "Tabela1", cnn, adOpenKeyset, adLockOptimistic
      
    contador_itens = fld.Items.Count

    For Each itm In fld.Items
        If itm.Class = olMail Then
            rst.AddNew
            rst!titulo = itm.Subject
            rst!Data = itm.ReceivedTime
            rst.Update
        End If
    Next itm
   
    rst.Close
    cnn.Close
   
    MsgBox "Fim"
 
End Subv