Microsoft 365 Choix du répertoire d'enregistrement en fonction du nom du fichier

Sub nomdossier()

x = ActiveWorkbook.Name 'nom du classeur actif
an = Mid(x, 17, 4)      'extraction de l'année dans le nom de fichier
mois = Mid(x, 14, 2)    'extration du mois dans le nom de fichier

Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(base & an) Then                     'On vérifie si le répertoire année existe
    rep = an
    If FSO.FolderExists(base & an & "/" & mois) Then    'On vérifie si le répertoire mois existe
        fichier = base & "/" & an & "/" & mois & "/" & ThisWorkbook.Name
    Else
        FSO.CreateFolder (base & an & "/" & mois)
        fichier = base & "/" & an & "/" & mois & "/" & ThisWorkbook.Name
    End If
Else
    FSO.CreateFolder (base & an)                        'On crée le répertoire année s'il n'existe pas
    FSO.CreateFolder (base & an & "\" & mois)           'On crée le répertoire mois s'il n'existe pas
End If
    chemin = base & an & "\" & mois & "\"               'Chemin d'enregistrement
    ActiveWorkbook.SaveAs chemin & ActiveWorkbook.Name  'Enregistrement du fichier
    ActiveWorkbook.Close SaveChanges:=False
End Sub