Listando emails do Outlook numa tabela do Access

Esta demanda partiu de um colega que precisou listar os emails pelos títulos em ordem cronológica.
Abaixo o código para consulta ou para quem precisar.
Rodamos no Office 2007.
Não esquecer de marcar a referência "Microsoft ActiveX Data Objects", qualquer versão.

;-)

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.JET.OLEDB.4.0;" & "Data Source=" & "C:\banco.mdb"

   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 Sub