Sub Leggi_Apputamenti_Outlook()
  Set Fa = ActiveSheet

  dInizio = Fa.Range("C2")
  dFine = Fa.Range("D2")

  Rf = Range("B:B").SpecialCells(xlCellTypeLastCell).Row
  If (Rf >= 5) Then Fa.Range(Rows(5), Rows(Rf)).Delete
  
  'è necessario il riferimento alla libreria di Outlook,
  'nell'editor VBA: Strumenti --> Riferimenti --> Microsoft Outlook xx.x Object Library
  Dim Outlook As Outlook.Application
  Dim oEvento As Outlook.AppointmentItem
  Set Outlook = New Outlook.Application
   
  'apre il calendario
  Set oCalendario = Outlook.Session.GetDefaultFolder(olFolderCalendar)
  Set oEventi = oCalendario.Items
  oEventi.IncludeRecurrences = True
  oEventi.Sort "[Start]"
  
  ' filtro data
  sFiltroData = "[Start] >= '" & Format$(dInizio, "dd/mm/yyyy hh:mm AMPM") & _
          "' AND [End] <= '" & Format$(dFine, "dd/mm/yyyy hh:mm AMPM") & "'"
  Set oEventiFiltrati = oEventi.Restrict(sFiltroData)
    
  Ra = 5
  For Each oEvento In oEventiFiltrati
    Cells(Ra, 2) = oEvento.Subject
    Cells(Ra, 3) = oEvento.Start
    Cells(Ra, 4) = oEvento.End
    Cells(Ra, 5) = oEvento.Categories
    Cells(Ra, 6) = oEvento.Location
    Cells(Ra, 7) = oEvento.Body
    Ra = Ra + 1
  Next
End Sub