VB créer des dossiers avec incrément

Fermé
Signaler
-
 Joel -
Bonjour,

J'aimerais savoir si quelqu'un aurait un code permettant de contrôler si un dossier existe et s'il existe, en créer un avec un numéro incrémenté.

Par exemple :

Si le dossier "ABC-01" existe, j'aimerais créer le "ABC-02". Et s'il n'existe pas, je souhaite le créer.

Et si possible, il faudrait que cela soit vérifié pour tous les numéros (si le 01 et le 02 existent, créer le 03, etc.)

Merci d'avance pour votre aide

Salutations,

Joël

1 réponse

J'ai trouvé une solution temporaire qui devrait aller pour l'instant (tant que le nombre de commandes n'est pas supérieur à 3 par jour en tout cas) :

Sub generate_date()     'Création du numéro de rapport et des fichiers
Dim date_ref$           'Date du pour le début de la référence
Dim chemin$             'Chemin pour l'enregistrement du dossier
date_ref = Format(Now(), "YY") & "-" & Format(Now(), "MM") & "-" & Format(Now(), "DD")
chemin = "X:\LABORATOIRE\ANALYSES DE COV\RAPPORTS\" & Format(Now(), "YYYY") & "\" & Format(Now(), "YY") & "-" & Format(Now(), "MM")
                                            'Génération du numéro
If dir$(chemin & "\" & date_ref & "-01-COV", vbDirectory) = vbNullString Then
'le répertoire n'existe pas, on le crée
MkDir chemin & "\" & date_ref & "-01-COV"
Sheets("Données commande").Range("D4").Value = date_ref & "-01-COV"
ActiveWorkbook.SaveAs Filename:=chemin & "\" & Sheets("Données commande").Range("D4") & "\" & Sheets("Données commande").Range("D4") & ".xlsm"
Else
If dir$(chemin & "\" & date_ref & "-02-COV", vbDirectory) = vbNullString Then
MkDir chemin & "\" & date_ref & "-02-COV"
Sheets("Données commande").Range("D4").Value = date_ref & "-02-COV"
ActiveWorkbook.SaveAs Filename:=chemin & "\" & Sheets("Données commande").Range("D4") & "\" & Sheets("Données commande").Range("D4") & ".xlsm"
Else
MkDir chemin & "\" & date_ref & "-03-COV"
Sheets("Données commande").Range("D4").Value = date_ref & "-03-COV"
ActiveWorkbook.SaveAs Filename:=chemin & "\" & Sheets("Données commande").Range("D4") & "\" & Sheets("Données commande").Range("D4") & ".xlsm"
'le répertoire existe
End If
End If
 
End Sub


Si quelqu'un a quelque chose d'un peu moins bricolé, je le prends volontiers
J'ai trouvé une boucle plus propre pour le faire :D
Vive l'autodidactie

x=0
do
x = x + 1
loop until dir("ABC-" & format(x, "00"), vbdirectory) = ""
mkdir ("ABC-" & format(x, "00")
end if