XL 2016 Suppression Dossiers

[KTM]

Bonjour Chers tous
Jai un fichier A et plusieurs sous dossiers contenus dans un meme dossier.
je voudrais insérer une macro dans mon fichier A qui pourra supprimer tous les sous dossiers excepter les sous dossiers X et Y
comment procéder ?
Merci

 

[Efgé]

Bonjour KTM

Je ne pouurais pas t'aider, mais...
Il serai préférable de faire "remonter" ta première demande plutôt que multiplier la même.

XL 2016 - Macro suppression Dossiers

Bonjour Chers tous Jai un fichier A et plusieurs sous dossiers contenus dans un meme dossier. je voudrais insérer une macro dans mon fichier A qui pourra supprimer tous les sous dossiers excepter les sous dossiers X et Y comment procéder ? Merci

www.excel-downloads.com

Si tu n'as pas de réponse, c'est peut-être que tu ne donne pas d'exemple du code que tu as déjà fait.

Cordialement

 

[KTM]

Bonjour KTM

Je ne pouurais pas t'aider, mais...
Il serai préférable de faire "remonter" ta première demande plutôt que multiplier la même.

XL 2016 - Macro suppression Dossiers

Bonjour Chers tous Jai un fichier A et plusieurs sous dossiers contenus dans un meme dossier. je voudrais insérer une macro dans mon fichier A qui pourra supprimer tous les sous dossiers excepter les sous dossiers X et Y comment procéder ? Merci

www.excel-downloads.com

Si tu n'as pas de réponse, c'est peut-être que tu ne donne pas d'exemple du code que tu as déjà fait.

Cordialement

Merci
Voici comment je supprime par exemple le sous dossier "M"

Sub SupprimerDossierM()
Dim dossier As String
dossier = ThisWorkbook.Path & "\M"
If Dir(dossier, vbDirectory) = "" Then Exit Sub
Dim FS
Set FS = CreateObject("Scripting.FileSystemObject")
FS.Deletefolder dossier
End Sub

Mon souci est comment boucler sur tous les autres sous dossiers excepter les sous dossiers X et Y et les supprimer d'un seul coup.
Je pense avoir mieux exposé ma preoccupation. Encore Merci.

 

[job75]

Bonjour KTM, Efgé,

En supposant que les dossiers à supprimer sont les sous-dossiers du dossier du fichier de la macro :

Sub SupprimerDossiers()
Dim chemin$, dossier$
chemin = ThisWorkbook.Path & "\"
dossier = Dir(chemin & "*", vbDirectory)
On Error Resume Next
While dossier <> ""
    If dossier <> "X" And dossier <> "Y" Then RmDir chemin & dossier
    dossier = Dir
Wend
End Sub

A+

 

[KTM]

Bonjour KTM, Efgé,

En supposant que les dossiers à supprimer sont les sous-dossiers du dossier du fichier de la macro :

Sub SupprimerDossiers()
Dim chemin$, dossier$
chemin = ThisWorkbook.Path & "\"
dossier = Dir(chemin & "*", vbDirectory)
On Error Resume Next
While dossier <> ""
    If dossier <> "X" And dossier <> "Y" Then RmDir chemin & dossier
    dossier = Dir
Wend
End Sub

A+

Merci Beaucoup Job75

 

[KTM]

Bonjour KTM, Efgé,

En supposant que les dossiers à supprimer sont les sous-dossiers du dossier du fichier de la macro :

Sub SupprimerDossiers()
Dim chemin$, dossier$
chemin = ThisWorkbook.Path & "\"
dossier = Dir(chemin & "*", vbDirectory)
On Error Resume Next
While dossier <> ""
    If dossier <> "X" And dossier <> "Y" Then RmDir chemin & dossier
    dossier = Dir
Wend
End Sub

A+

Merci à Vous
J'ai adapté comme suit pour supprimer tous les dossiers sauf "MySave" mais je voudrais mettre en debut de procedure cette instruction:
"si le dossier MySave est seul dossier alors Exit Sub"


Sub Supprimer_ToutDossier()
("si le dossier MySave est seul dossier alors Exit Sub")
Dim chemin$, dossier$
chemin = ThisWorkbook.Path & "\"
dossier = Dir(chemin & "*", vbDirectory)
On Error Resume Next
While dossier <> ""
If dossier <> "MySave" Then RmDir chemin & dossier
dossier = Dir
Wend
End Sub

 

[KTM]

Bonjour KTM, Efgé,

En supposant que les dossiers à supprimer sont les sous-dossiers du dossier du fichier de la macro :

Sub SupprimerDossiers()
Dim chemin$, dossier$
chemin = ThisWorkbook.Path & "\"
dossier = Dir(chemin & "*", vbDirectory)
On Error Resume Next
While dossier <> ""
    If dossier <> "X" And dossier <> "Y" Then RmDir chemin & dossier
    dossier = Dir
Wend
End Sub

A+

OK. Mais il se trouve que la macro ne supprime que les Dossiers vides

 

[job75]

Bonjour KTM, le forum,

Mais il se trouve que la macro ne supprime que les Dossiers vides

Oui, alors utiliser :

Sub SupprimerDossiers()
Dim chemin$, sf As Object
chemin = ThisWorkbook.Path
For Each sf In CreateObject("Scripting.FileSystemObject").GetFolder(chemin).Subfolders
    If sf.Name <> "X" And sf.Name <> "Y" Then sf.Delete
Next
End Sub

Bonne journée.

 

[KTM]

Bonjour KTM, le forum,

Oui, alors utiliser :

Sub SupprimerDossiers()
Dim chemin$, sf As Object
chemin = ThisWorkbook.Path
For Each sf In CreateObject("Scripting.FileSystemObject").GetFolder(chemin).Subfolders
    If sf.Name <> "X" And sf.Name <> "Y" Then sf.Delete
Next
End Sub

Bonne journée.

Merci Job75 ca marche hyper bien. Un dernier detail pour clore ce sujet:
j'aimerais transcrire en debut de procedure cette instruction:
"Si X et Y sont les seuls dossiers presents alors Exit sub"

Sub SupprimerDossiers()
"Si X et Y sont les seuls dossiers presents alors Exit sub"
Dim chemin$, sf As Object
chemin = ThisWorkbook.Path
For Each sf In CreateObject("Scripting.FileSystemObject").GetFolder(chemin).Subfolders
If sf.Name <> "X" And sf.Name <> "Y" Then sf.Delete
Next
End Sub

Merci Encore pour tout

 

[job75]

j'aimerais transcrire en debut de procedure cette instruction:
"Si X et Y sont les seuls dossiers presents alors Exit sub"

Quel intérêt ? Si X et/ou Y sont les seuls dossiers présents la macro n'exécute rien !!!

 

[KTM]

Quel intérêt ? Si X et/ou Y sont les seuls dossiers présents la macro n'exécute rien !!!

En fait je voudrais inserrer une msgbox pour signaler a l'utilisateur qu'il n'ya pas de dossiers a supprimer

 

[job75]

Les débutants mettent des MsgBox partout mais bon :

Sub SupprimerDossiers()
Dim chemin$, sf As Object, flag As Boolean
chemin = ThisWorkbook.Path
For Each sf In CreateObject("Scripting.FileSystemObject").GetFolder(chemin).Subfolders
    If sf.Name <> "X" And sf.Name <> "Y" Then sf.Delete: flag = True
Next
If Not flag Then MsgBox "Aucun dossier supprimé..."
End Sub

 

[KTM]

Les débutants mettent des MsgBox partout mais bon :

Sub SupprimerDossiers()
Dim chemin$, sf As Object, flag As Boolean
chemin = ThisWorkbook.Path
For Each sf In CreateObject("Scripting.FileSystemObject").GetFolder(chemin).Subfolders
    If sf.Name <> "X" And sf.Name <> "Y" Then sf.Delete: flag = True
Next
If Not flag Then MsgBox "Aucun dossier supprimé..."
End Sub

merci