VBA supprimer sous-répertoires

[C@thy]

Bonjour le forum,

j'essaie vainement de supprimer des sous-répertoires, sauf ceux contenus dans un tableau.
Voici mon code :

Dim chemin as string
Dim Toblo()
Dim i as integer
Dim fd As folder
Dim FSO As Scripting.FileSystemObject    'ICI ERREUR Type défini par l'utilisateur non défini
 
chemin = Thisworkbook.Path
'Instanciation du FSO
Set FSO = New Scripting.FileSystemObject
Set fd = FSO.getfolder(chemin)
Tablo = Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi")
For Each SousDossier In Dossier.SubFolders
    For i = 0 To UBound(Tablo)
        if fd.name <> Tablo(i) then fd.Delete
    next i
next SousDossier

Je travaille sur MSOffice 2003.

Merci à vous🙂.

C@thy

 

[C@thy]

Re : VBA supprimer sous-répertoires

Arf! j'ai compris!

il faut cocher Microsoft Scripting Runtime,

mais ma macro n'est pas bonne, j'ai essayé

Dim fd As folder
Set fd = FSO.getfolder(chemin)
Tablo = Array("lundi", "mardi", "mercredi", "jeudi", "vendredi")
For Each SousDossier In Dossier.SubFolders
For I = 0 To UBound(Tablo)
If SousDossier.Name = Tablo(I) Then
GoTo suit
Else
SousDossier.Delete
End If
suit:
Next I
Next SousDossier

mais pas ça non plus

Biz

C@thy

 

[tototiti2008]

Re : VBA supprimer sous-répertoires

Bonjour Cathy,

mais ma macro n'est pas bonne, j'ai essayé

c'est à dire ? elle supprime tous les sous-dossiers ? ou aucun ?

si elle les supprime tous, c'est dû à la structure du code
le nom de ton sous-dossier ne peut être égal à tous les noms de ton tableau

 

[PascalXLD]

Re : VBA supprimer sous-répertoires

Bonjour

Je ne crois pas que Delete fonctionnera il faudra passer par RmDIr

Bonne journée et bises à C@thy

 

[tototiti2008]

Re : VBA supprimer sous-répertoires

Bonjour Pascal,
Re,

L'aide dit que Delete devrait supprimer le dossier qu'il contiennne des fichier ou non
Attendez j'essaye

si, si, ça fonctionne trés bien 😉

à tester

Dim fd As folder, DansTablo as boolean
Set fd = FSO.getfolder(chemin)
Tablo = Array("lundi", "mardi", "mercredi", "jeudi", "vendredi")
for Each SousDossier In Dossier.SubFolders
danstablo = false
For I = 0 To UBound(Tablo)
If SousDossier.Name = Tablo(I) Then 
danstablo = true
exit for
End If
Next I
if not danstablo then sousdossier.delete
Next SousDossier

 

[mromain]

Re : VBA supprimer sous-répertoires

Bonjour Cathy, Tototiti, Pascal,


Pour éviter d'avoir à cocher la référence Microsoft Scripting Runtime, tu peux modifier le code lors de la déclaration des objets et de l'instanciation du FileSystemObject. Comme ça :

Sub Test()
Dim i As Integer, dansTablo As Boolean, chemin As String, Tablo()
Dim fd As Object, fd2 As Object, FSO As Object
 
    chemin = ThisWorkbook.Path
    'Instanciation du FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set fd = FSO.getfolder(chemin)
    Tablo = Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi")
    For Each fd2 In fd.SubFolders
        dansTablo = False
        For i = 0 To UBound(Tablo)
            If fd2.Name = Tablo(i) Then
                dansTablo = True
                Exit For
            End If
        Next i
        If Not dansTablo Then fd2.Delete
    Next fd2
End Sub

a+

 

[tototiti2008]

Re : VBA supprimer sous-répertoires

Bonjour mromain,

Oups, j'avais pas vu le passage de fd à Dossier qui forcément ne devait pas permettre de faire fonctionner le code, bien vu

Par contre une remarque : attention aux majuscules dans les noms de jours de semaine, VBA est sensible à la casse.

Cathy a proposé une fois "lundi" et une autre "Lundi", ce qui n'est pas égal au sens VBA, à moins de passer par un Ucase

 

[C@thy]

Re : VBA supprimer sous-répertoires

Merci les boyz

bien vu tototiti, ça me supprimait tout, effectivement la structure de mon code n'était pas bonne

oui, j'ai corrigé avec les minuscules car mes répertoires n'ont pas de majuscules, et, du coup il n'y avait jamais égalité.

et oui, il y avait fd et dossier, vous êtes trop forts, tous!!!

Salut à l'ami Pascal en passant!

Bises

C@thy

 

[C@thy]

Re : VBA supprimer sous-répertoires

Tototititatatutu, ça marche superbien

mRomain, j'ai une erreur sur Set fd = FSO.getfolder(chemin)

il me dit objet requis.

un grand Merci à vous

Biz

C@thy