Enregistrement chemin précis

Bonjour Forum ,

Je me tourne vers vous pour essayer de trouver une solution à mon problème.

J'ai un horaire que je souhaite automatiser sa sauvegarde vers un répertoire précis. Toutefois, cerépertoire contient des dossiers pour les années>dossiers par mois>dossier par jours

voici un chemin par exemple:

Je souhaiterais que la macro détecte la date se trouvant à la cellule "C12" puis vérifie si les répertoires année, mois et jour existent, si un des répertoires n'existe pas, et bien elle le crée.

PS: il existe déjà un code au Module1, si vous souhaitez y jeter un coup d’œil.

bonjour

une petite fonction qui fait le travail demandé...

Fred

'Nécessite d'activer la référence "Microsoft Scripting RunTime" dans l'éditeur de macros (Alt+F11):
'Menu Outils\Références
'Cochez la ligne "Microsoft Scripting RunTime". Cliquez sur le bouton OK pour valider.
Sub verif_dossier()
Dim Rep As String
Dim annee, mois, jour, moisnb As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")                               
Rep = ThisWorkbook.Path & "\"   ' initialisation de la variable a adapter le chemin de depart
annee = Year([c12])
moisnb = Month([c12])
mois = MonthName(moisnb)
jour = Day([c12])
Rep = Rep & Year([c12]) & "\"
If Not fso.FolderExists(Rep) Then fso.CreateFolder Rep
Rep = Rep & moisnb & "-" & mois & "\"
If Not fso.FolderExists(Rep) Then fso.CreateFolder Rep
Rep = Rep & jour & "\"
If Not fso.FolderExists(Rep) Then fso.CreateFolder Rep
Set fso = Nothing
End Sub

Bonjour le forum, fred2406,

Superbe! Le code répond parfaitement à la demande.

Est-ce possible de me dire s'il y a moyen d'ajouter une instruction qui enregistre le fichier au format .xls

Le nom du fichier serait formaté ainsi:

Nom de l'onglet_jj-mm-aaaa_cellule C5.xls

C5= nom du responsable RH

De plus, je veux ajouter ces deux msgbox

MsgBox "Le répertoire a été créé.", vbInformation, "Dotation"

MsgBox "Ce répertoire existe déjà.", vbInformation, "Dotation"

bonjour

un essai, si j'ai bien compris l'histoire des msgbox.... perso je ne l'aurais pas fait.... mais bon

Fred

'Nécessite d'activer la référence "Microsoft Scripting RunTime" dans l'éditeur de macros (Alt+F11):
'Menu Outils\Références
'Cochez la ligne "Microsoft Scripting RunTime". Cliquez sur le bouton OK pour valider.
Sub verif_dossier()
Dim Rep, newfile As String
Dim annee, mois, jour, moisnb As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")                                
Rep = ThisWorkbook.Path & "\"
annee = Year([c12])
moisnb = Month([c12])
mois = MonthName(moisnb)
jour = Day([c12])
Rep = Rep & Year([c12]) & "\"
If Not fso.FolderExists(Rep) Then
    fso.CreateFolder Rep
    MsgBox "Le répertoire " & annee & " a été créé.", vbInformation, "Dotation"
Else
    MsgBox "Ce répertoire " & annee & " existe déjà.", vbInformation, "Dotation"
End If
Rep = Rep & moisnb & "-" & mois & "\"
If Not fso.FolderExists(Rep) Then
    fso.CreateFolder Rep
    MsgBox "Le répertoire " & moisnb & "-" & mois & " a été créé.", vbInformation, "Dotation"
Else
    MsgBox "Ce répertoire " & moisnb & "-" & mois & " existe déjà.", vbInformation, "Dotation"
End If
Rep = Rep & jour & "\"
If Not fso.FolderExists(Rep) Then
    fso.CreateFolder Rep
    MsgBox "Le répertoire " & jour & " a été créé.", vbInformation, "Dotation"
Else
    MsgBox "Ce répertoire " & jour & " existe déjà.", vbInformation, "Dotation"
End If
newfile = Rep & ActiveSheet.Name & "_" & Format$([c12], "dd-mm-yyyy") & "_" & [C5] & ".xls"
ActiveWorkbook.SaveAs Filename:=newfile, FileFormat:=56
Set fso = Nothing
End Sub

Bonjour le forum, Fred2406,

Merci pour cette macro, c'est plus que parfait.

Par curiosité, pourquoi auriez-vous évité l'ajout de msgbox ?

Re bonjour

Trop de clic de souris.... enfin cela dépend du nombre de fichiers par jour...

Fred