Sub test()
Dim Dossier As String, SousDossier As String
Dossier = ActiveWorkbook.Path & "\Enregistrement"
SousDossier = Dossier & "\" & Year(Date)
Call RépertoireExiste(Dossier)
Call RépertoireExiste(SousDossier)
Dim Nom As String
Nom = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & "_" & ActiveWorkbook.Name
ActiveWorkbook.SaveCopyAs SousDossier & "\" & Nom
rep = MsgBox("Votre base de données est sauvegardée sous le nom : " & Nom, vbYes + vbInformation, "Copie sauvegarde classeur")
End Sub
Function RépertoireExiste(Chemin As String) As Boolean
On Error Resume Next
RépertoireExiste = GetAttr(Chemin) And vbDirectory
If RépertoireExiste = True Then
Exit Function
Else
MkDir (Chemin)
End If
End Function