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