[VBA] Création de dossiers quand ils n'éxistent pas

Fermé

ghang - 2 mars 2016 à 09:54
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 2 mars 2016 à 13:28

Bonjour,

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

    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)
    
    
    
Suite2:

On Error GoTo Suite3
    If Dir(NomRepertoire & "\" & NomDossier & "\" & Annee & "\" & Mois) = "" Then MkDir (NomRepertoire & "\" & NomDossier & "\" & Annee & "\" & Mois)
    

Suite3:

Merci pour votre aide.

A voir également:

Mkdir vba
[VBA] Création dossier MkDir ✓ - Forum VB / VBA
Mkdir - p signification ✓ - Forum Linux / Unix
L'indice n'appartient pas à la sélection vba - Forum VB / VBA
Incompatibilité de type vba ✓ - Forum Programmation
Excel compter cellule couleur sans vba - Guide

5 réponses

Réponse 1 / 5

Mosca
2 mars 2016 à 10:09

Bonjour,

Tu ne dis pas quelle erreur, ni à quel endroit ça se produit.
De plus la macro est incomplète...

Difficile dans ces conditions de pouvoir t'aider.

A+

Réponse 2 / 5

ghang
2 mars 2016 à 10:23


Sub CréaArchiEnregistrement()

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)            

Suite2:

On Error GoTo Suite3    

If Dir(NomRepertoire & "\" & NomDossier & "\" & Annee & "\" & Mois) = "" Then MkDir (NomRepertoire & "\" & NomDossier & "\" & Annee & "\" & Mois)    

Suite3:

NomFichier = NomDossier & "_" & Annee & "_" & Mois & ".xlsx"

 
 
Sheets("Synthèse").Select
    Range("G4:K114").Select
    Selection.Copy
    Workbooks.Add
    Application.DisplayAlerts = False
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    
With ActiveWorkbook
 .SaveAs Filename:=NomRepertoire & "\" & NomDossier & "\" & Annee & "\" & Mois & "\" & NomFichier
 .Close
 
 End With
 
    Application.DisplayAlerts = True
    

End Sub

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.

"Erreur d'exécution '75':

Erreur d'accès Chemin/Fichier"

Réponse 3 / 5

Mosca
2 mars 2016 à 11:06

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

If Dir(NomRepertoire & "\" & NomDossier & "\" & Annee & "\" & Mois) = "" Then MkDir (NomRepertoire & "\" & NomDossier & "\" & Annee & "\" & Mois)    

Suite3:

NomFichier = NomDossier & "_" & Annee & "_" & Mois & ".xlsx"

A+

ghang
2 mars 2016 à 11:14

j'ai essayé tel que tu me l'a proposé, ca ne fonctionne pas malheureusement :(

Mosca > ghang
2 mars 2016 à 11:21

Une autre piste:

mets le chemin dans une variable, si ça plante place la souris sur le nom de la variable pour afficher le contenu

par exemple
Chemin=NomRepertoire & "\" & NomDossier & "\" & Annee

If Dir(Chemin) = "" Then MkDir (Chemin)

ghang
2 mars 2016 à 11:33

Merci pour ta réponse.

j'ai essayé ca du coups :

Chemin = NomRepertoire & "\" & NomDossier

If Dir(Chemin) = "" Then MkDir (Chemin)

CheminAN = Chemin & "\" & Annee

If Dir(CheminAN) = "" Then MkDir (CheminAN)
    
CheminMois = CheminAN & "\" & Mois

If Dir(CheminMois) = "" Then MkDir (CheminMois)

Même erreur, la partie en gras est surlignée...

Je deviens fou !

Réponse 5 / 5

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 759
2 mars 2016 à 13:28

Bonjour,

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.

Discussions similaires

[VBA] Création dossier MkDir

[Excel VBA] Créer des dossiers sous VBA

mkdir dossier/sous dossier

Macro enregistrer en PDF

Accéder à un répertoire à partir de .GetOpenFilename

Récupérer les noms des fichiers présents dans un dossier