Attribute VB_Name = "EsportaEmail"
Public Sub SaveCategorizedEmailsFromAllFolders()
    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder
    Dim BaseFilePath As String
    Dim Tags As Variant
    Dim Tag As Variant
    
    ' Crea un'istanza di Outlook
    Set objOutlook = Outlook.Application
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    
    ' Imposta il percorso base dove salvare le email
    BaseFilePath = "\\mediaset.it\share\Indirizzo_controllo_risorse\EMAIL_CA\"
    Tags = Array("CA-conferma acquisto", "CA-ok comitato", "CA-ok icr")  ' Modifica con i nomi dei tag desiderati
    
    ' Assicurati che le cartelle esistano, altrimenti creale
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    Dim TagPath As String
    For Each Tag In Tags
        TagPath = BaseFilePath & Tag & "\"
        If Not fs.FolderExists(TagPath) Then
            fs.CreateFolder TagPath
        End If
        ' Verifica se il file LOG.TXT esiste già, se non esiste, crealo
        If Not fs.FileExists(TagPath & "LOG.TXT") Then
            Dim logFile As Object
            Set logFile = fs.CreateTextFile(TagPath & "LOG.TXT", True)
            logFile.Close
        End If
    Next Tag
    
    ' Inizia dalla cartella principale di Outlook
    Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox).Parent
    
    ' Chiama la funzione ricorsiva per ogni tag
    For Each Tag In Tags
        ProcessFolders objFolder, BaseFilePath & Tag & "\", Tag, fs
    Next Tag
End Sub


Private Sub ProcessFolders(ByVal objFolder As Outlook.MAPIFolder, ByVal strFilePath As String, ByVal Tag As String, ByVal fs As Object)
    Dim objSubFolder As Outlook.MAPIFolder
    Dim objItem As Object
    Dim objMail As Outlook.MailItem
    Dim logFile As Object
    Dim fileName As String
    Dim dictExported As Object
    Set dictExported = CreateObject("Scripting.Dictionary")

    ' Carica i nomi delle email già esportate nel dictionary se il file esiste
    If fs.FileExists(strFilePath & "LOG.TXT") Then
        Set logFile = fs.OpenTextFile(strFilePath & "LOG.TXT", 1)
        Do Until logFile.AtEndOfStream
            dictExported(logFile.ReadLine) = True
        Loop
        logFile.Close
    End If

    ' Apri il file di log per appendere nuove righe alla fine del processo
    Set logFile = fs.OpenTextFile(strFilePath & "LOG.TXT", 8, True)

    ' Esamina ogni email nella cartella corrente
    For Each objItem In objFolder.Items
        If TypeName(objItem) = "MailItem" Then
            Set objMail = objItem
            ' Controlla se la mail ha il tag specificato
            If InStr(1, objMail.Categories, Tag, vbTextCompare) > 0 Then
                ' Formatta la data di ricezione e sanifica il nome, poi prepara il nome del file
                Dim formattedDate As String
                formattedDate = Format(objMail.ReceivedTime, "yyyy-mm-dd")
                fileName = formattedDate & " " & SanitizeFileName(objMail.Subject) & ".msg"

                ' Verifica se il file è già stato esportato
                If Not dictExported.Exists(fileName) Then
                    objMail.SaveAs strFilePath & fileName, olMSG
                    logFile.WriteLine fileName
                End If
            End If
        End If
    Next objItem

    logFile.Close

    ' Esamina le sottocartelle
    For Each objSubFolder In objFolder.Folders
        ProcessFolders objSubFolder, strFilePath, Tag, fs
    Next objSubFolder
End Sub

Function IsFileExported(ByVal exportedFiles As String, ByVal fileName As String) As Boolean
    IsFileExported = InStr(1, exportedFiles, fileName, vbTextCompare) > 0
End Function



Function SanitizeFileName(ByVal fileName As String) As String
    Dim InvalidChars As String
    InvalidChars = "\/:*?""<>|"
    
    Dim i As Integer
    For i = 1 To Len(InvalidChars)
        fileName = Replace(fileName, Mid(InvalidChars, i, 1), "")
    Next i
    
    SanitizeFileName = fileName
End Function