VB créer des dossiers avec incrément

Joel -
Joel - 4 janv. 2011 à 10:20

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

Afficher la suite

A voir également:

VB créer des dossiers avec incrément
Créer un lien pour partager des photos - Guide
Comment créer un groupe whatsapp - Guide
Créer un compte google - Guide
Comment créer un compte gmail - Guide
Créer une carte avec des points - Guide

1 réponse

Réponse 1 / 1

Joel

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

Joel

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

Votre réponse