VBA EXCEL Suppression de SousDossiers(vides)
Bonjour,
J'espère que j'utilise correctement ce forum car je ne suis pas un habitué...
Je ne maîtrise pas les scripting object ... et je me heurte à une difficulté pour laquelle je ne trouve pas la solution.
Dans un dossier "Bibliothèque", j'ai un très grand nombre de sous-dossiers Auteur qui contiennent chacun des livres électroniques.
Le nom de chaque livre contient le nom de l'auteur et le titre du livre.
Pour une utilisation plus simple, je souhaiterais finalement :
- déplacer tous mes livres dans le dossier parent intitulé "Bibliothèque"
- puis supprimer chaque sous-dossier Auteur une fois vidé...
En m'inspirant d'un exemple trouvé sur ce forum j'ai voulu adapter un seul script pour réaliser cela.
Le déplacement des livres des sous-dossiers Auteur dans le répertoire parent Bibliothèque fonctionne correctement (1er script).
Je me suis inspiré de la même logique (2ème script) pour réaliser la suppression des sous-dossiers car lorsque je voulais l'intégrer dans le 1er script,
j'avais un plantage après la suppression du 1er sous-dossier Auteur... mais j'ai le même problème avec le 2ème script...
La suppression du 1er sous-dossier Auteur semble "casser" la logique du script car SubFolder devient "Nothing"
Je soumets mes 2 scripts car je peine ... et ne trouve pas de solution...
Merci d'avance.
Code:
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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
| Sub DéplacerLesLivresDansBibliothèque(Repertoire As String)
'-->Nécessite d'activer la référence "Microsoft Scripting RunTime"
'Dans l'éditeur de macros (Alt+F11):
'Menu Outils
'Références
'Cocher la ligne "Microsoft Scripting RunTime".
'Cliquer sur le bouton OK pour valider.
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(Repertoire)
'Boucle sur tous les fichiers du répertoire
If Not SourceFolder.Name = "Bibliothèque" _
And Not SourceFolder.Name = "Sauvegardes" Then
'MsgBox SourceFolder.Name, , "Répertoire"
i = i + 1
DossierOrigine = ThisWorkbook.Path & Application.PathSeparator & SourceFolder.Name & Application.PathSeparator
DossierDestination = ThisWorkbook.Path & Application.PathSeparator
For Each FileItem In SourceFolder.Files
FSO.MoveFile DossierOrigine & FileItem.Name, DossierDestination & FileItem.Name
j = j + 1
Next FileItem
End If
'--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
For Each SubFolder In SourceFolder.SubFolders
DéplacerLesLivresDansBibliothèque SubFolder.Path
Next SubFolder
End Sub
Sub Supprimer_les_SousDossiersAuteur(Repertoire As String)
'-->Nécessite d'activer la référence "Microsoft Scripting RunTime"
'Dans l'éditeur de macros (Alt+F11):
'Menu Outils
'Références
'Cocher la ligne "Microsoft Scripting RunTime".
'Cliquer sur le bouton OK pour valider.
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(Repertoire)
'Boucle sur tous les fichiers du répertoire
If Not SourceFolder.Name = "Bibliothèque" _
And Not SourceFolder.Name = "Sauvegardes" Then
VBA.RmDir Repertoire '...Supprime le SousDossier
MsgBox Repertoire, , "Suppression du dossier"
End If
'--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
For Each SubFolder In SourceFolder.SubFolders '<-- Le plantage est sur cette instruction
Supprimer_les_SousDossiersAuteur SubFolder.Path
Next SubFolder
End Sub |
Oui les sous-dossiers sont vides
Merci d'avoir regardé.
J'ai testé le 1er script VBA qui fonctionne correctement, donc,
Les sous-dossiers Auteur sont tous totalement vides après l'exécution du 1er script : Plus aucun fichier (ils ont été déplacés dans le dossier parent "Bibliothèque") et ils ne contiennent pas de sous-dossier de 2ème niveau
RmDir fonctionne bien puisque le 1er sous-dossier Auteur a bien été supprimé ... ce n'est pas cette instruction qui plante
J'espère que quelqu'un trouvera la solution car j'imagine qu'il y a forcément une solution...
Merci encore.
Solution trouvée ...[B]Sujet [Résolu][/B]
Finalement, j'abandonne l'utilisation du FSO dans le 2ème script.:roll:
Dans le 1er script, lors du déplacement des fichiers contenus dans les sous-dossiers Auteur, je liste les noms des sous-dossiers dans une feuille excel ... puis dans le 2ème script, une simple boucle VBA dans la feuille pour appliquer le RmDir ... qui fonctionne parfaitement.;)
Sujet [Résolu]
