Pourriez vous me dire ce qui cloche avec ce morceau de code ?
La création des dossiers foctionne parfaitement, cependant dans le cas où tous les dossiers sont déja présent, si je relance la macro, elle m'envoie un message d'erreur au lieu de passer a la suite :/
Sub CréaArchiEnregistrement() Dim NomRepertoire As String, NomDossier As String, Annee As String, Mois As String
Dim NomRepertoire As String, NomDossier As String, Annee As String, Mois As String NomRepertoire = "\\prnas02" NomDossier = Range("B1") Annee = Range("B2") Mois = Range("B3")
On Error GoTo Suite If Dir(NomRepertoire & "\" & NomDossier) = "" Then MkDir (NomRepertoire & "\" & NomDossier)
Suite:
On Error GoTo Suite2 If Dir(NomRepertoire & "\" & NomDossier & "\" & Annee) = "" Then MkDir (NomRepertoire & "\" & NomDossier & "\" & Annee)
Mon erreur est localisée sur la partie en gras ci dessus ( Then MkDir (NomRepertoire & "\" & NomDossier & "\" & Annee) )
Mais ca ne fait aucun sens il me semble.
La suite du code n'a pas grand interêt dans la résolution de ce problème mais je te l'ai ajoutée.
j'ai fait tourner chaques partie du code séparément afin de m'assurer de la provenance du soucis.
Lorsque les dossiers n'existent pas, ils se créent sans erreur, par contre lorsque TOUS les dossiers existent déja, la macro m'affiche une erreur.
Comme c'est ecrit, tu n'a n'as pas besoin des On Error Goto.
Essayes en mettant les lignes en commentaires et regardes si l'erreur survient encore.
'On Error GoTo Suite : inutile car l'erreur est gérée par la condition If If Dir(NomRepertoire & "\" & NomDossier) = "" Then MkDir (NomRepertoire & "\" & NomDossier)
Suite:
' On Error GoTo Suite2 : inutile car l'erreur est gérée par la condition If If Dir(NomRepertoire & "\" & NomDossier & "\" & Annee) = "" Then MkDir (NomRepertoire & "\" & NomDossier & "\" & Annee)
Suite2:
'On Error GoTo Suite3 : inutile car l'erreur est gérée par la condition If
Une variante avec l'api windows :
Celle-ci va créer le sous dossier Mois, dans le sous dossier Annee, dans le sous dossier NomDossier, dans le sous-dossier NomRepertoire, et cela, même si NomRepertoire, NomDossier, Annee et Mois existent (ou non...)
Option Explicit
Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
(ByVal hwnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long
Sub test()
Dim L As Long, Repertoire As String
Dim NomRepertoire As String, NomDossier As String, Annee As String, Mois As String
NomRepertoire = "C:\Users\monNom\Desktop"
NomDossier = "Dossier163\"
Annee = "2016"
Mois = "février"
Repertoire = NomRepertoire & "\" & NomDossier & "\" & Annee & "\" & Mois
L = SHCreateDirectoryEx(0&, Repertoire, 0&)
'possibilité de tester L (0= création du rép, 183 = rép déjà créé)
End Sub
Qui plus est, si le nom du répertoire proposé contient un caractère interdit (exemple : \), celui-ci sera supprimé du nom et donc, le répertoire sera créé quand même.
