Bonjour à tous,
Je débute sur VBA, et depuis maintenant une semaine j'essaye de créer une macro qui me permet de créer des dossiers et sous dossiers en fonction de listes sur ma feuille excel, pour cela j'ai réussi à composer ma macro.
De plus, il est question de copier un fichier source dans le dossier créer. Au final je me retrouve avec un dossier composé de plusieurs sous dossiers et un fichier. Pour le moment on va dire que tout va bien
Cela fonctionne sous un principe de boucle.
Maintenant je voudrais en partant toujours de la même ligne, débuter une vérification des dossiers existants en fonction de ma feuille excel et lorsque la boucle arrive sur un dossier inexistant je voudrais avoir une message box qui me dit "le dossier "..." n'existe pas ! Voulez-vous le créer ?" Oui ou Non. Si "Oui" la macro poursuit la procédure avec la création du fichier excel et si Non la macro s'arrête.
Voici le code que j'ai pu composé :
Avec ce code j'arrive à tout faire ce dont j'ai besoin en création de fichiers mais dès lors que je lance la commande elle se répète autant que je veux sans prendre en compte si le dossier existe ou pas, pareil pour le fichier alors qu'il y a "OverwriteExisting", je ne comprends pas car ca a marché pendant un moment en en modifiant certaines lignes et en ajoutant des lignes ça ne marche plus.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50 Sub CreationRepertoires() Sheets("Pour la macro").Activate On Error Resume Next i = 84 While Cells(i, 1).Value <> "" If Dir(ActiveWorkbook.Path & "\" & Cells(i, 1).Value) <> "" Then MsgBox "Le dossier " & Sheets("Liste des études").Range("E1").End(xlDown).Value & " existe déjà" Else MkDir ActiveWorkbook.Path & "\" & Cells(i, 1) If Cells(i, 2).Value = "EXE" Then For j = 2 To 14 MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(j, 3).Value Next j Else For j = 2 To 11 MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(j, 4).Value Next j End If End If MsgBox "Le dossier suivant a été créé :" & Chr(10) & Sheets("Liste des études").Cells(i, 5) Exit Sub i = i + 1 Wend On Error GoTo Message_derreur If MsgBox("Voulez-vous créer le fichier répertoire ?", vbQuestion + vbYesNo) = vbYes Then Const OverwriteExisting = False Set objFSO = CreateObject("Scripting.FileSystemObject") objFSO.CopyFile "\\Commun\DOSSIER DE TRAVAIL\NR\Développement gestion client\YYNNN AVP\YYNNN AVP EXE - Répertoire.xlsx", "\\Commun\DOSSIER DE TRAVAIL\NR\Développement gestion client\" & "\" & Sheets("Pour la macro").Cells(i, 1).Value & "\" & Sheets("Pour la macro").Cells(i, 1).Value & " - Répertoire" & ".xlsx", OverwriteExisting MsgBox "Le fichier répertoire a bien été créé." Else MsgBox "Le fichier répertoire n'a pas été créé.", vbCritical End If Exit Sub Message_derreur: MsgBox "Le fichier répertoire existe déjà", vbCritical Sheets("Liste des études").Activate End Sub
J'espère que l'un d'entre vous va pouvoir solutionner mon problème.
Merci d'avance.
PS: Désolé si le code est un peu fouilli je suis débutant
Jok3rnoir,
Partager