Attribute VB_Name = "EsportaCalendario"
Sub ExportCalendarAppointments()
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.NameSpace
    Dim olFolder As Outlook.Folder
    Dim olItems As Outlook.Items
    Dim olItem As Object
    Dim olAccounts As Outlook.Accounts
    Dim olAccount As Outlook.Account
    Dim filePath As String
    Dim fileNum As Integer
    Dim startDate As Date
    Dim endDate As Date
    Dim appointmentCount As Long
    
    ' Crea un'istanza di Outlook
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olAccounts = olNamespace.Accounts
    
    ' Imposta la data di inizio all'oggi e la data di fine a un anno da oggi
    startDate = Date
    endDate = DateAdd("yyyy", 1, startDate)
    
    ' Specifica il percorso del file di output
    filePath = "C:\Users\Mauro Gagliardi\Dropbox\Assistente_Personale_Mauro\Sistema_Assistente\calendar_export.md"
    ' Apri il file per la scrittura
    fileNum = FreeFile
    Open filePath For Output As fileNum
    
    Print #fileNum, "Esportazione appuntamenti da " & Format(startDate, "dd/mm/yyyy") & " a " & Format(endDate, "dd/mm/yyyy")
    Print #fileNum, "-----------------------------"
    
    appointmentCount = 0
    
    ' Itera attraverso tutti gli account
    For Each olAccount In olAccounts
        ' Ottieni la cartella del calendario per l'account corrente
        On Error Resume Next
        Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)
        If Err.Number <> 0 Then
            Print #fileNum, "Errore nell'accesso al calendario per l'account: " & olAccount.DisplayName
            Err.Clear
            GoTo NextAccount
        End If
        On Error GoTo 0
        
        If olFolder Is Nothing Then
            Print #fileNum, "Non è stato possibile trovare la cartella del calendario per l'account: " & olAccount.DisplayName
            GoTo NextAccount
        End If
        
        Set olItems = olFolder.Items
        olItems.Sort "[Start]"
        olItems.IncludeRecurrences = False
        
        ' Filtra gli elementi per la data di inizio e fine
        Set olItems = olItems.Restrict("[Start] >= '" & Format(startDate, "dd/mm/yyyy") & "' AND [Start] <= '" & Format(endDate, "dd/mm/yyyy") & "'")
        
        ' Itera attraverso gli appuntamenti e scrivili nel file
        For Each olItem In olItems
            If TypeName(olItem) = "AppointmentItem" Then
                Dim appt As AppointmentItem
                Set appt = olItem
                
                ' Esporta solo se non è ricorrente
                If appt.RecurrenceState = olApptNotRecurring Then
                    Call ExportAppointment(fileNum, olAccount.DisplayName, appt)
                    appointmentCount = appointmentCount + 1
                End If
            End If
        Next olItem
        
NextAccount:
    Next olAccount
    
    ' Chiudi il file
    Print #fileNum, "-----------------------------"
    Print #fileNum, "Totale appuntamenti esportati: " & appointmentCount
    Close #fileNum
    
    ' Pulisci gli oggetti
    Set olItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
    
    'MsgBox "L'esportazione degli appuntamenti è completata." & vbNewLine & _
           appointmentCount & " appuntamenti non ricorrenti esportati." & vbNewLine & _
           "Il file è stato salvato in: " & filePath
End Sub

Sub ExportAppointment(fileNum As Integer, accountName As String, appt As AppointmentItem)
    Print #fileNum, "Account: " & accountName
    Print #fileNum, "Oggetto: " & appt.Subject
    Print #fileNum, "Inizio: " & Format(appt.Start, "dd/mm/yyyy HH:mm")
    Print #fileNum, "Fine: " & Format(appt.End, "dd/mm/yyyy HH:mm")
    Print #fileNum, "Luogo: " & appt.Location
    Print #fileNum, "-----------------------------"
End Sub