Discussion :

[Pipeti]

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 :

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
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

[unparia]

Bonjour
Je n'utilise pas FSO (VBS est inhibé sur ma machine) et ne suis donc pas en mesure de tester ton code.
Juste un mot, à tout hasard, dans ce cas : L'instruction RmDir ne peut supprimer un dossier que s'il est ENTIEREMENT VIDE. N'est pas entièrement vide un dossier contenant un/des sous-dossier(s) même si ces derniers sont eux-mêmes vides.

[Pipeti]

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.

[unparia]

RmDir fonctionne bien puisque le 1er sous-dossier Auteur a bien été supprimé

voilà une conclusion tirée bien rapidement (pure coïncidence possible) . Tu devrais la vérifier

EDIT : et tu devrais également vérifier qu'aucun des fichiers et/ou dossiers à supprimer n'est en cours d'utilisation

[Pipeti]

Bonjour,
J'avais déjà vérifié auparavant !
Cordialement.

[Pipeti]

Finalement, j'abandonne l'utilisation du FSO dans le 2ème script.
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]