Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le supprime.
J'espère que ma question et assez claire et si surtout cela est possible.
Merci d'avance, Jacques
Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le supprime.
J'espère que ma question et assez claire et si surtout cela est possible.
Merci d'avance, Jacques
Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le supprime.
J'espère que ma question et assez claire et si surtout cela est possible.
Merci d'avance, Jacques
Salut,
C'est possible de le faire, mais ça comporte différents obstacles.
Il faut, d'une part, utiliser une fonction récursive, mais aussi faire
attention de ne pas effacer un répertoire qui ne contient pas de fichier
mais qui contient un sous-répertoire qui, lui, contient des fichiers...
J'ai monté un petit programme qui semble fonctionner mais qu'il faut tout
de
même tester sur des répertoires bidons.
Le processus consiste à lister tous les répertoires.
Ensuite, il suffit de boucler ces répertoires et effacer tous ceux qui
n'ont
pas de fichier ni de sous-répertoire
Je ne sais pas si je dois attacher le fichier à mon message, inscrire le
code directement dans le corps du message ou le déposer à un endroit
queconque (?)
J'utilise Outlook Express
Michel
"Jacques" a écrit dans le message de
news:42fe4b5c$0$25038$Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est possible.
Merci d'avance, Jacques
Salut,
C'est possible de le faire, mais ça comporte différents obstacles.
Il faut, d'une part, utiliser une fonction récursive, mais aussi faire
attention de ne pas effacer un répertoire qui ne contient pas de fichier
mais qui contient un sous-répertoire qui, lui, contient des fichiers...
J'ai monté un petit programme qui semble fonctionner mais qu'il faut tout
de
même tester sur des répertoires bidons.
Le processus consiste à lister tous les répertoires.
Ensuite, il suffit de boucler ces répertoires et effacer tous ceux qui
n'ont
pas de fichier ni de sous-répertoire
Je ne sais pas si je dois attacher le fichier à mon message, inscrire le
code directement dans le corps du message ou le déposer à un endroit
queconque (?)
J'utilise Outlook Express
Michel
"Jacques" <jacques-zeziola@wanadoo.fr> a écrit dans le message de
news:42fe4b5c$0$25038$8fcfb975@news.wanadoo.fr...
Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est possible.
Merci d'avance, Jacques
Salut,
C'est possible de le faire, mais ça comporte différents obstacles.
Il faut, d'une part, utiliser une fonction récursive, mais aussi faire
attention de ne pas effacer un répertoire qui ne contient pas de fichier
mais qui contient un sous-répertoire qui, lui, contient des fichiers...
J'ai monté un petit programme qui semble fonctionner mais qu'il faut tout
de
même tester sur des répertoires bidons.
Le processus consiste à lister tous les répertoires.
Ensuite, il suffit de boucler ces répertoires et effacer tous ceux qui
n'ont
pas de fichier ni de sous-répertoire
Je ne sais pas si je dois attacher le fichier à mon message, inscrire le
code directement dans le corps du message ou le déposer à un endroit
queconque (?)
J'utilise Outlook Express
Michel
"Jacques" a écrit dans le message de
news:42fe4b5c$0$25038$Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est possible.
Merci d'avance, Jacques
Salut,
C'est possible de le faire, mais ça comporte différents obstacles.
Il faut, d'une part, utiliser une fonction récursive, mais aussi faire
attention de ne pas effacer un répertoire qui ne contient pas de fichier
mais qui contient un sous-répertoire qui, lui, contient des fichiers...
J'ai monté un petit programme qui semble fonctionner mais qu'il faut tout
de
même tester sur des répertoires bidons.
Le processus consiste à lister tous les répertoires.
Ensuite, il suffit de boucler ces répertoires et effacer tous ceux qui
n'ont
pas de fichier ni de sous-répertoire
Je ne sais pas si je dois attacher le fichier à mon message, inscrire le
code directement dans le corps du message ou le déposer à un endroit
queconque (?)
J'utilise Outlook Express
Michel
"Jacques" a écrit dans le message de
news:42fe4b5c$0$25038$Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est possible.
Merci d'avance, Jacques
Salut,
C'est possible de le faire, mais ça comporte différents obstacles.
Il faut, d'une part, utiliser une fonction récursive, mais aussi faire
attention de ne pas effacer un répertoire qui ne contient pas de fichier
mais qui contient un sous-répertoire qui, lui, contient des fichiers...
J'ai monté un petit programme qui semble fonctionner mais qu'il faut tout
de
même tester sur des répertoires bidons.
Le processus consiste à lister tous les répertoires.
Ensuite, il suffit de boucler ces répertoires et effacer tous ceux qui
n'ont
pas de fichier ni de sous-répertoire
Je ne sais pas si je dois attacher le fichier à mon message, inscrire le
code directement dans le corps du message ou le déposer à un endroit
queconque (?)
J'utilise Outlook Express
Michel
"Jacques" <jacques-zeziola@wanadoo.fr> a écrit dans le message de
news:42fe4b5c$0$25038$8fcfb975@news.wanadoo.fr...
Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est possible.
Merci d'avance, Jacques
Salut,
C'est possible de le faire, mais ça comporte différents obstacles.
Il faut, d'une part, utiliser une fonction récursive, mais aussi faire
attention de ne pas effacer un répertoire qui ne contient pas de fichier
mais qui contient un sous-répertoire qui, lui, contient des fichiers...
J'ai monté un petit programme qui semble fonctionner mais qu'il faut tout
de
même tester sur des répertoires bidons.
Le processus consiste à lister tous les répertoires.
Ensuite, il suffit de boucler ces répertoires et effacer tous ceux qui
n'ont
pas de fichier ni de sous-répertoire
Je ne sais pas si je dois attacher le fichier à mon message, inscrire le
code directement dans le corps du message ou le déposer à un endroit
queconque (?)
J'utilise Outlook Express
Michel
"Jacques" a écrit dans le message de
news:42fe4b5c$0$25038$Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est possible.
Merci d'avance, Jacques
Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le supprime.
J'espère que ma question et assez claire et si surtout cela est possible.
Merci d'avance, Jacques
Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le supprime.
J'espère que ma question et assez claire et si surtout cela est possible.
Merci d'avance, Jacques
Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le supprime.
J'espère que ma question et assez claire et si surtout cela est possible.
Merci d'avance, Jacques
Bonjour Jacques,
| supprimer normalement tous dossiers vide suite a un trie de tag et
rename,
| et a un retriage par une macro d'excel, qui me renvoie tous mes fichiers
a
| leur place, et supprime les dossiers vide (Fait par un internaute).
La procédure proposée n'a jamais pris soin de supprimer quelques
répertoires vides que ce soit... cet élément ne fut jamais stipulé
dans la question. Elle se contentait de détruire (commande inhibée) les
fichiers qui avaient été copiés vers un autre répertoire
afin que tu puisses tester la procédure sécuritairement.
Voici une adaptation de la même procédure qui déplace les fichiers désirés
vers un autre répertoire et supprime le répertoire source
désigné si ce dernier est vide. Prend soin lors des premières exécutions
(test) d'avoir une copie ailleurs du répertoire source en
cas de pépin.
'--------------------------------------------------
Sub DeplacerMP3_SelonLeurDebit()
Dim sPath As String, Dest22050 As String
Dim Dest44100 As String, Debit As String
Dim p$, n$, oFile As Object
Dim objShell As Object, oFolder As Object
Dim Fs As Object
Dim F As Object
'Répertoire où sont les fichiers musicaux
sPath = "c:Music"
'Répertoire de destination pour débit 22050
'ce répertoire doit exister avant de lancer la macro
Dest22050 = "c:Music22050"
'Répertoir de destination pour débit de 44100
'ce répertoire doit exister avant de lancer la macro
Dest44100 = "c:Music44100"
If sPath = "" Then Exit Sub
If Dir(sPath, vbDirectory) = "" Then
MsgBox "Répertoire inexistant."
Exit Sub
End If
If Dir(Dest22050, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour 22050 inexistant."
Exit Sub
End If
If Dir(Dest44100, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour Dest44100 inexistant."
Exit Sub
End If
Set Fs = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.Namespace(CStr(sPath))
For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name
If Right$(n, 4) = ".mp3" Then
Debit = Left(oFolder.GetDetailsOf(oFile, 22), 3)
Select Case Left(oFolder.GetDetailsOf(oFile, 22), 3)
Case Is = "128"
'Rien ne se passe.. rien n'est prévu
Case Is = "192"
'rien ne se passe ...
Case Is = "320"
'Rien de prévue pour l'instant.
Case Is > "22,0" 'pour 22,050
Fs.MoveFile p, Dest22050 & n
Case Is > "44,1"
Fs.MoveFile p, Dest22050 & n
End Select
End If
Next
's'assurer que le répertoire est vide avant de le supprimer
Set F = Fs.GetFolder(sPath)
If F.SubFolders.Count = 0 And F.Files.Count = 0 Then
Fs.DeleteFile sPath
End If
Set Fs = Nothing: Set F = Nothing
Set oFolder = Nothing: Set objShell = Nothing
End Sub
'--------------------------------------------------
Salutations!
"Jacques" a écrit dans le message de news:
42fedde0$0$877$
MPi, le forum
Merci de ta réponse.
Le principe et bien cela.
Mes dossiers, on bien des fois un sous répertoir, qui peu contenir des
fichier, c'est trés rare, car en faite cette petite appli, me sert a
Mais il arrive que cette suppression n'ai pas lieu par une mauvaise
manipulation de ma part (A force de trier, des dossiers restent vide et je
ne peu le savoir, sauf en les regardant un par un dans l'explorateur (J'ai
prés de 3000 dossiers a vérifier).
Donc voila, le but.
Pour ce qui est du code, fait un copier / coller dans ton message.
Merci, Jacques
"MPi" a écrit dans le message de news:
H9xLe.66113$Salut,
C'est possible de le faire, mais ça comporte différents obstacles.
Il faut, d'une part, utiliser une fonction récursive, mais aussi faire
attention de ne pas effacer un répertoire qui ne contient pas de fichier
mais qui contient un sous-répertoire qui, lui, contient des fichiers...
J'ai monté un petit programme qui semble fonctionner mais qu'il faut tout
de
même tester sur des répertoires bidons.
Le processus consiste à lister tous les répertoires.
Ensuite, il suffit de boucler ces répertoires et effacer tous ceux qui
n'ont
pas de fichier ni de sous-répertoire
Je ne sais pas si je dois attacher le fichier à mon message, inscrire le
code directement dans le corps du message ou le déposer à un endroit
queconque (?)
J'utilise Outlook Express
Michel
"Jacques" a écrit dans le message de
news:42fe4b5c$0$25038$Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est
possible.
Merci d'avance, Jacques
Bonjour Jacques,
| supprimer normalement tous dossiers vide suite a un trie de tag et
rename,
| et a un retriage par une macro d'excel, qui me renvoie tous mes fichiers
a
| leur place, et supprime les dossiers vide (Fait par un internaute).
La procédure proposée n'a jamais pris soin de supprimer quelques
répertoires vides que ce soit... cet élément ne fut jamais stipulé
dans la question. Elle se contentait de détruire (commande inhibée) les
fichiers qui avaient été copiés vers un autre répertoire
afin que tu puisses tester la procédure sécuritairement.
Voici une adaptation de la même procédure qui déplace les fichiers désirés
vers un autre répertoire et supprime le répertoire source
désigné si ce dernier est vide. Prend soin lors des premières exécutions
(test) d'avoir une copie ailleurs du répertoire source en
cas de pépin.
'--------------------------------------------------
Sub DeplacerMP3_SelonLeurDebit()
Dim sPath As String, Dest22050 As String
Dim Dest44100 As String, Debit As String
Dim p$, n$, oFile As Object
Dim objShell As Object, oFolder As Object
Dim Fs As Object
Dim F As Object
'Répertoire où sont les fichiers musicaux
sPath = "c:Music"
'Répertoire de destination pour débit 22050
'ce répertoire doit exister avant de lancer la macro
Dest22050 = "c:Music22050"
'Répertoir de destination pour débit de 44100
'ce répertoire doit exister avant de lancer la macro
Dest44100 = "c:Music44100"
If sPath = "" Then Exit Sub
If Dir(sPath, vbDirectory) = "" Then
MsgBox "Répertoire inexistant."
Exit Sub
End If
If Dir(Dest22050, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour 22050 inexistant."
Exit Sub
End If
If Dir(Dest44100, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour Dest44100 inexistant."
Exit Sub
End If
Set Fs = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.Namespace(CStr(sPath))
For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name
If Right$(n, 4) = ".mp3" Then
Debit = Left(oFolder.GetDetailsOf(oFile, 22), 3)
Select Case Left(oFolder.GetDetailsOf(oFile, 22), 3)
Case Is = "128"
'Rien ne se passe.. rien n'est prévu
Case Is = "192"
'rien ne se passe ...
Case Is = "320"
'Rien de prévue pour l'instant.
Case Is > "22,0" 'pour 22,050
Fs.MoveFile p, Dest22050 & n
Case Is > "44,1"
Fs.MoveFile p, Dest22050 & n
End Select
End If
Next
's'assurer que le répertoire est vide avant de le supprimer
Set F = Fs.GetFolder(sPath)
If F.SubFolders.Count = 0 And F.Files.Count = 0 Then
Fs.DeleteFile sPath
End If
Set Fs = Nothing: Set F = Nothing
Set oFolder = Nothing: Set objShell = Nothing
End Sub
'--------------------------------------------------
Salutations!
"Jacques" <jacques-zeziola@wanadoo.fr> a écrit dans le message de news:
42fedde0$0$877$8fcfb975@news.wanadoo.fr...
MPi, le forum
Merci de ta réponse.
Le principe et bien cela.
Mes dossiers, on bien des fois un sous répertoir, qui peu contenir des
fichier, c'est trés rare, car en faite cette petite appli, me sert a
Mais il arrive que cette suppression n'ai pas lieu par une mauvaise
manipulation de ma part (A force de trier, des dossiers restent vide et je
ne peu le savoir, sauf en les regardant un par un dans l'explorateur (J'ai
prés de 3000 dossiers a vérifier).
Donc voila, le but.
Pour ce qui est du code, fait un copier / coller dans ton message.
Merci, Jacques
"MPi" <m_pare@supprimer.videotron.ca> a écrit dans le message de news:
H9xLe.66113$pX4.854727@weber.videotron.net...
Salut,
C'est possible de le faire, mais ça comporte différents obstacles.
Il faut, d'une part, utiliser une fonction récursive, mais aussi faire
attention de ne pas effacer un répertoire qui ne contient pas de fichier
mais qui contient un sous-répertoire qui, lui, contient des fichiers...
J'ai monté un petit programme qui semble fonctionner mais qu'il faut tout
de
même tester sur des répertoires bidons.
Le processus consiste à lister tous les répertoires.
Ensuite, il suffit de boucler ces répertoires et effacer tous ceux qui
n'ont
pas de fichier ni de sous-répertoire
Je ne sais pas si je dois attacher le fichier à mon message, inscrire le
code directement dans le corps du message ou le déposer à un endroit
queconque (?)
J'utilise Outlook Express
Michel
"Jacques" <jacques-zeziola@wanadoo.fr> a écrit dans le message de
news:42fe4b5c$0$25038$8fcfb975@news.wanadoo.fr...
Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est
possible.
Merci d'avance, Jacques
Bonjour Jacques,
| supprimer normalement tous dossiers vide suite a un trie de tag et
rename,
| et a un retriage par une macro d'excel, qui me renvoie tous mes fichiers
a
| leur place, et supprime les dossiers vide (Fait par un internaute).
La procédure proposée n'a jamais pris soin de supprimer quelques
répertoires vides que ce soit... cet élément ne fut jamais stipulé
dans la question. Elle se contentait de détruire (commande inhibée) les
fichiers qui avaient été copiés vers un autre répertoire
afin que tu puisses tester la procédure sécuritairement.
Voici une adaptation de la même procédure qui déplace les fichiers désirés
vers un autre répertoire et supprime le répertoire source
désigné si ce dernier est vide. Prend soin lors des premières exécutions
(test) d'avoir une copie ailleurs du répertoire source en
cas de pépin.
'--------------------------------------------------
Sub DeplacerMP3_SelonLeurDebit()
Dim sPath As String, Dest22050 As String
Dim Dest44100 As String, Debit As String
Dim p$, n$, oFile As Object
Dim objShell As Object, oFolder As Object
Dim Fs As Object
Dim F As Object
'Répertoire où sont les fichiers musicaux
sPath = "c:Music"
'Répertoire de destination pour débit 22050
'ce répertoire doit exister avant de lancer la macro
Dest22050 = "c:Music22050"
'Répertoir de destination pour débit de 44100
'ce répertoire doit exister avant de lancer la macro
Dest44100 = "c:Music44100"
If sPath = "" Then Exit Sub
If Dir(sPath, vbDirectory) = "" Then
MsgBox "Répertoire inexistant."
Exit Sub
End If
If Dir(Dest22050, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour 22050 inexistant."
Exit Sub
End If
If Dir(Dest44100, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour Dest44100 inexistant."
Exit Sub
End If
Set Fs = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.Namespace(CStr(sPath))
For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name
If Right$(n, 4) = ".mp3" Then
Debit = Left(oFolder.GetDetailsOf(oFile, 22), 3)
Select Case Left(oFolder.GetDetailsOf(oFile, 22), 3)
Case Is = "128"
'Rien ne se passe.. rien n'est prévu
Case Is = "192"
'rien ne se passe ...
Case Is = "320"
'Rien de prévue pour l'instant.
Case Is > "22,0" 'pour 22,050
Fs.MoveFile p, Dest22050 & n
Case Is > "44,1"
Fs.MoveFile p, Dest22050 & n
End Select
End If
Next
's'assurer que le répertoire est vide avant de le supprimer
Set F = Fs.GetFolder(sPath)
If F.SubFolders.Count = 0 And F.Files.Count = 0 Then
Fs.DeleteFile sPath
End If
Set Fs = Nothing: Set F = Nothing
Set oFolder = Nothing: Set objShell = Nothing
End Sub
'--------------------------------------------------
Salutations!
"Jacques" a écrit dans le message de news:
42fedde0$0$877$
MPi, le forum
Merci de ta réponse.
Le principe et bien cela.
Mes dossiers, on bien des fois un sous répertoir, qui peu contenir des
fichier, c'est trés rare, car en faite cette petite appli, me sert a
Mais il arrive que cette suppression n'ai pas lieu par une mauvaise
manipulation de ma part (A force de trier, des dossiers restent vide et je
ne peu le savoir, sauf en les regardant un par un dans l'explorateur (J'ai
prés de 3000 dossiers a vérifier).
Donc voila, le but.
Pour ce qui est du code, fait un copier / coller dans ton message.
Merci, Jacques
"MPi" a écrit dans le message de news:
H9xLe.66113$Salut,
C'est possible de le faire, mais ça comporte différents obstacles.
Il faut, d'une part, utiliser une fonction récursive, mais aussi faire
attention de ne pas effacer un répertoire qui ne contient pas de fichier
mais qui contient un sous-répertoire qui, lui, contient des fichiers...
J'ai monté un petit programme qui semble fonctionner mais qu'il faut tout
de
même tester sur des répertoires bidons.
Le processus consiste à lister tous les répertoires.
Ensuite, il suffit de boucler ces répertoires et effacer tous ceux qui
n'ont
pas de fichier ni de sous-répertoire
Je ne sais pas si je dois attacher le fichier à mon message, inscrire le
code directement dans le corps du message ou le déposer à un endroit
queconque (?)
J'utilise Outlook Express
Michel
"Jacques" a écrit dans le message de
news:42fe4b5c$0$25038$Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est
possible.
Merci d'avance, Jacques
Bonjour Jacques,
| supprimer normalement tous dossiers vide suite a un trie de tag et
rename,
| et a un retriage par une macro d'excel, qui me renvoie tous mes fichiers
a
| leur place, et supprime les dossiers vide (Fait par un internaute).
La procédure proposée n'a jamais pris soin de supprimer quelques
répertoires vides que ce soit... cet élément ne fut jamais stipulé
dans la question. Elle se contentait de détruire (commande inhibée) les
fichiers qui avaient été copiés vers un autre répertoire
afin que tu puisses tester la procédure sécuritairement.
Voici une adaptation de la même procédure qui déplace les fichiers désirés
vers un autre répertoire et supprime le répertoire source
désigné si ce dernier est vide. Prend soin lors des premières exécutions
(test) d'avoir une copie ailleurs du répertoire source en
cas de pépin.
'--------------------------------------------------
Sub DeplacerMP3_SelonLeurDebit()
Dim sPath As String, Dest22050 As String
Dim Dest44100 As String, Debit As String
Dim p$, n$, oFile As Object
Dim objShell As Object, oFolder As Object
Dim Fs As Object
Dim F As Object
'Répertoire où sont les fichiers musicaux
sPath = "c:Music"
'Répertoire de destination pour débit 22050
'ce répertoire doit exister avant de lancer la macro
Dest22050 = "c:Music22050"
'Répertoir de destination pour débit de 44100
'ce répertoire doit exister avant de lancer la macro
Dest44100 = "c:Music44100"
If sPath = "" Then Exit Sub
If Dir(sPath, vbDirectory) = "" Then
MsgBox "Répertoire inexistant."
Exit Sub
End If
If Dir(Dest22050, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour 22050 inexistant."
Exit Sub
End If
If Dir(Dest44100, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour Dest44100 inexistant."
Exit Sub
End If
Set Fs = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.Namespace(CStr(sPath))
For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name
If Right$(n, 4) = ".mp3" Then
Debit = Left(oFolder.GetDetailsOf(oFile, 22), 3)
Select Case Left(oFolder.GetDetailsOf(oFile, 22), 3)
Case Is = "128"
'Rien ne se passe.. rien n'est prévu
Case Is = "192"
'rien ne se passe ...
Case Is = "320"
'Rien de prévue pour l'instant.
Case Is > "22,0" 'pour 22,050
Fs.MoveFile p, Dest22050 & n
Case Is > "44,1"
Fs.MoveFile p, Dest22050 & n
End Select
End If
Next
's'assurer que le répertoire est vide avant de le supprimer
Set F = Fs.GetFolder(sPath)
If F.SubFolders.Count = 0 And F.Files.Count = 0 Then
Fs.DeleteFile sPath
End If
Set Fs = Nothing: Set F = Nothing
Set oFolder = Nothing: Set objShell = Nothing
End Sub
'--------------------------------------------------
Salutations!
"Jacques" a écrit dans le message de news:
42fedde0$0$877$
MPi, le forum
Merci de ta réponse.
Le principe et bien cela.
Mes dossiers, on bien des fois un sous répertoir, qui peu contenir des
fichier, c'est trés rare, car en faite cette petite appli, me sert a
Mais il arrive que cette suppression n'ai pas lieu par une mauvaise
manipulation de ma part (A force de trier, des dossiers restent vide et je
ne peu le savoir, sauf en les regardant un par un dans l'explorateur (J'ai
prés de 3000 dossiers a vérifier).
Donc voila, le but.
Pour ce qui est du code, fait un copier / coller dans ton message.
Merci, Jacques
"MPi" a écrit dans le message de news:
H9xLe.66113$Salut,
C'est possible de le faire, mais ça comporte différents obstacles.
Il faut, d'une part, utiliser une fonction récursive, mais aussi faire
attention de ne pas effacer un répertoire qui ne contient pas de fichier
mais qui contient un sous-répertoire qui, lui, contient des fichiers...
J'ai monté un petit programme qui semble fonctionner mais qu'il faut tout
de
même tester sur des répertoires bidons.
Le processus consiste à lister tous les répertoires.
Ensuite, il suffit de boucler ces répertoires et effacer tous ceux qui
n'ont
pas de fichier ni de sous-répertoire
Je ne sais pas si je dois attacher le fichier à mon message, inscrire le
code directement dans le corps du message ou le déposer à un endroit
queconque (?)
J'utilise Outlook Express
Michel
"Jacques" a écrit dans le message de
news:42fe4b5c$0$25038$Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est
possible.
Merci d'avance, Jacques
Bonjour Jacques,
| supprimer normalement tous dossiers vide suite a un trie de tag et
rename,
| et a un retriage par une macro d'excel, qui me renvoie tous mes fichiers
a
| leur place, et supprime les dossiers vide (Fait par un internaute).
La procédure proposée n'a jamais pris soin de supprimer quelques
répertoires vides que ce soit... cet élément ne fut jamais stipulé
dans la question. Elle se contentait de détruire (commande inhibée) les
fichiers qui avaient été copiés vers un autre répertoire
afin que tu puisses tester la procédure sécuritairement.
Voici une adaptation de la même procédure qui déplace les fichiers désirés
vers un autre répertoire et supprime le répertoire source
désigné si ce dernier est vide. Prend soin lors des premières exécutions
(test) d'avoir une copie ailleurs du répertoire source en
cas de pépin.
'--------------------------------------------------
Sub DeplacerMP3_SelonLeurDebit()
Dim sPath As String, Dest22050 As String
Dim Dest44100 As String, Debit As String
Dim p$, n$, oFile As Object
Dim objShell As Object, oFolder As Object
Dim Fs As Object
Dim F As Object
'Répertoire où sont les fichiers musicaux
sPath = "c:Music"
'Répertoire de destination pour débit 22050
'ce répertoire doit exister avant de lancer la macro
Dest22050 = "c:Music22050"
'Répertoir de destination pour débit de 44100
'ce répertoire doit exister avant de lancer la macro
Dest44100 = "c:Music44100"
If sPath = "" Then Exit Sub
If Dir(sPath, vbDirectory) = "" Then
MsgBox "Répertoire inexistant."
Exit Sub
End If
If Dir(Dest22050, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour 22050 inexistant."
Exit Sub
End If
If Dir(Dest44100, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour Dest44100 inexistant."
Exit Sub
End If
Set Fs = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.Namespace(CStr(sPath))
For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name
If Right$(n, 4) = ".mp3" Then
Debit = Left(oFolder.GetDetailsOf(oFile, 22), 3)
Select Case Left(oFolder.GetDetailsOf(oFile, 22), 3)
Case Is = "128"
'Rien ne se passe.. rien n'est prévu
Case Is = "192"
'rien ne se passe ...
Case Is = "320"
'Rien de prévue pour l'instant.
Case Is > "22,0" 'pour 22,050
Fs.MoveFile p, Dest22050 & n
Case Is > "44,1"
Fs.MoveFile p, Dest22050 & n
End Select
End If
Next
's'assurer que le répertoire est vide avant de le supprimer
Set F = Fs.GetFolder(sPath)
If F.SubFolders.Count = 0 And F.Files.Count = 0 Then
Fs.DeleteFile sPath
End If
Set Fs = Nothing: Set F = Nothing
Set oFolder = Nothing: Set objShell = Nothing
End Sub
'--------------------------------------------------
Salutations!
"Jacques" <jacques-zeziola@wanadoo.fr> a écrit dans le message de news:
42fedde0$0$877$8fcfb975@news.wanadoo.fr...
MPi, le forum
Merci de ta réponse.
Le principe et bien cela.
Mes dossiers, on bien des fois un sous répertoir, qui peu contenir des
fichier, c'est trés rare, car en faite cette petite appli, me sert a
Mais il arrive que cette suppression n'ai pas lieu par une mauvaise
manipulation de ma part (A force de trier, des dossiers restent vide et je
ne peu le savoir, sauf en les regardant un par un dans l'explorateur (J'ai
prés de 3000 dossiers a vérifier).
Donc voila, le but.
Pour ce qui est du code, fait un copier / coller dans ton message.
Merci, Jacques
"MPi" <m_pare@supprimer.videotron.ca> a écrit dans le message de news:
H9xLe.66113$pX4.854727@weber.videotron.net...
Salut,
C'est possible de le faire, mais ça comporte différents obstacles.
Il faut, d'une part, utiliser une fonction récursive, mais aussi faire
attention de ne pas effacer un répertoire qui ne contient pas de fichier
mais qui contient un sous-répertoire qui, lui, contient des fichiers...
J'ai monté un petit programme qui semble fonctionner mais qu'il faut tout
de
même tester sur des répertoires bidons.
Le processus consiste à lister tous les répertoires.
Ensuite, il suffit de boucler ces répertoires et effacer tous ceux qui
n'ont
pas de fichier ni de sous-répertoire
Je ne sais pas si je dois attacher le fichier à mon message, inscrire le
code directement dans le corps du message ou le déposer à un endroit
queconque (?)
J'utilise Outlook Express
Michel
"Jacques" <jacques-zeziola@wanadoo.fr> a écrit dans le message de
news:42fe4b5c$0$25038$8fcfb975@news.wanadoo.fr...
Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est
possible.
Merci d'avance, Jacques
Bonjour Jacques,
| supprimer normalement tous dossiers vide suite a un trie de tag et
rename,
| et a un retriage par une macro d'excel, qui me renvoie tous mes fichiers
a
| leur place, et supprime les dossiers vide (Fait par un internaute).
La procédure proposée n'a jamais pris soin de supprimer quelques
répertoires vides que ce soit... cet élément ne fut jamais stipulé
dans la question. Elle se contentait de détruire (commande inhibée) les
fichiers qui avaient été copiés vers un autre répertoire
afin que tu puisses tester la procédure sécuritairement.
Voici une adaptation de la même procédure qui déplace les fichiers désirés
vers un autre répertoire et supprime le répertoire source
désigné si ce dernier est vide. Prend soin lors des premières exécutions
(test) d'avoir une copie ailleurs du répertoire source en
cas de pépin.
'--------------------------------------------------
Sub DeplacerMP3_SelonLeurDebit()
Dim sPath As String, Dest22050 As String
Dim Dest44100 As String, Debit As String
Dim p$, n$, oFile As Object
Dim objShell As Object, oFolder As Object
Dim Fs As Object
Dim F As Object
'Répertoire où sont les fichiers musicaux
sPath = "c:Music"
'Répertoire de destination pour débit 22050
'ce répertoire doit exister avant de lancer la macro
Dest22050 = "c:Music22050"
'Répertoir de destination pour débit de 44100
'ce répertoire doit exister avant de lancer la macro
Dest44100 = "c:Music44100"
If sPath = "" Then Exit Sub
If Dir(sPath, vbDirectory) = "" Then
MsgBox "Répertoire inexistant."
Exit Sub
End If
If Dir(Dest22050, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour 22050 inexistant."
Exit Sub
End If
If Dir(Dest44100, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour Dest44100 inexistant."
Exit Sub
End If
Set Fs = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.Namespace(CStr(sPath))
For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name
If Right$(n, 4) = ".mp3" Then
Debit = Left(oFolder.GetDetailsOf(oFile, 22), 3)
Select Case Left(oFolder.GetDetailsOf(oFile, 22), 3)
Case Is = "128"
'Rien ne se passe.. rien n'est prévu
Case Is = "192"
'rien ne se passe ...
Case Is = "320"
'Rien de prévue pour l'instant.
Case Is > "22,0" 'pour 22,050
Fs.MoveFile p, Dest22050 & n
Case Is > "44,1"
Fs.MoveFile p, Dest22050 & n
End Select
End If
Next
's'assurer que le répertoire est vide avant de le supprimer
Set F = Fs.GetFolder(sPath)
If F.SubFolders.Count = 0 And F.Files.Count = 0 Then
Fs.DeleteFile sPath
End If
Set Fs = Nothing: Set F = Nothing
Set oFolder = Nothing: Set objShell = Nothing
End Sub
'--------------------------------------------------
Salutations!
"Jacques" a écrit dans le message de news:
42fedde0$0$877$
MPi, le forum
Merci de ta réponse.
Le principe et bien cela.
Mes dossiers, on bien des fois un sous répertoir, qui peu contenir des
fichier, c'est trés rare, car en faite cette petite appli, me sert a
Mais il arrive que cette suppression n'ai pas lieu par une mauvaise
manipulation de ma part (A force de trier, des dossiers restent vide et je
ne peu le savoir, sauf en les regardant un par un dans l'explorateur (J'ai
prés de 3000 dossiers a vérifier).
Donc voila, le but.
Pour ce qui est du code, fait un copier / coller dans ton message.
Merci, Jacques
"MPi" a écrit dans le message de news:
H9xLe.66113$Salut,
C'est possible de le faire, mais ça comporte différents obstacles.
Il faut, d'une part, utiliser une fonction récursive, mais aussi faire
attention de ne pas effacer un répertoire qui ne contient pas de fichier
mais qui contient un sous-répertoire qui, lui, contient des fichiers...
J'ai monté un petit programme qui semble fonctionner mais qu'il faut tout
de
même tester sur des répertoires bidons.
Le processus consiste à lister tous les répertoires.
Ensuite, il suffit de boucler ces répertoires et effacer tous ceux qui
n'ont
pas de fichier ni de sous-répertoire
Je ne sais pas si je dois attacher le fichier à mon message, inscrire le
code directement dans le corps du message ou le déposer à un endroit
queconque (?)
J'utilise Outlook Express
Michel
"Jacques" a écrit dans le message de
news:42fe4b5c$0$25038$Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est
possible.
Merci d'avance, Jacques
Salut,
Voici ce que j'ai fait
Fais plusieurs tests sur des copies de tes répertoires
Démarre la fonction RechercheRépertoires à partir d'une feuille vierge (ou
qui n'a rien en colonne A)
Dans cette colonne s'inscriront les noms des répertoires effacés, histoire
de faire un suivi de ce qui s'est passé...
Le programme n'est pas en béton et peut certainement être amélioré
Bonne chance !
----------------------------------------------------------------------------
----------
Option Explicit
Private Tablo()
Private IndexTablo As Integer
'Macro de départ
Sub RechercheRépertoires()
Dim nbRep As Integer
Cells.ClearContents
Range("A1").Select
Range("A1") = "Répertoires supprimés"
Do
IndexTablo = 0
ReDim Tablo(0)
ListerRépertoires "C:Test" ' répertoire principal à rechercher
nbRep = UBound(Tablo)
EffacerRépertoiresVides
Loop While UBound(Tablo) <> nbRep
End Sub
'Remplir un tableau avec les répertoires
Private Sub ListerRépertoires(FilePath As Variant)
Dim Fichier As Variant
Dim Liste As Collection
On Error GoTo Erreur
If Right(FilePath, 1) <> "" Then
FilePath = FilePath & ""
End If
Set Liste = New Collection
Fichier = Dir(FilePath & "*.*", vbDirectory + vbHidden + vbSystem)
While Fichier > ""
If GetAttr(FilePath & Fichier) And vbDirectory Then
If Left(Fichier, 1) <> "." Then
Liste.Add FilePath & Fichier
ReDim Preserve Tablo(IndexTablo)
Tablo(IndexTablo) = FilePath & Fichier & ""
IndexTablo = IndexTablo + 1
End If
End If
Fichier = Dir
DoEvents
Wend
For Each Fichier In Liste
ListerRépertoires Fichier
DoEvents
Next
Set Liste = Nothing
Exit Sub
Erreur:
MsgBox Err.Number & vbCrLf & Err.Description
End Sub
'Scanner tous les répertoires notés dans le tableau
Sub EffacerRépertoiresVides()
Dim I As Integer, DerniereLigne As Integer
Dim Fichier, SousRep, Trouvé As Boolean
On Error GoTo Erreur
For I = 0 To UBound(Tablo)
Trouvé = False
If I > UBound(Tablo) Then Exit Sub
'vérifier si un sous-répertoire est présent
SousRep = Dir(Tablo(I) & "*.*", vbDirectory + vbHidden + vbSystem)
While SousRep > ""
If GetAttr(Tablo(I) & SousRep) And vbDirectory Then
If Left(SousRep, 1) <> "." Then
Trouvé = True 'un sous-répertoire est présent
End If
End If
SousRep = Dir
Wend
Fichier = Dir(Tablo(I) & "*.*")
If Fichier = "" And Not Trouvé Then
DerniereLigne = Range("A65536").End(xlUp).Row + 1
RmDir Tablo(I) 'effacer le répertoire
Range("A" & DerniereLigne) = Tablo(I)
EnleverÉlément I
End If
Next
Exit Sub
Erreur:
MsgBox Err.Description
End Sub
'Enlever le nom du répertoire supprimé du tableau
Sub EnleverÉlément(Idx As Integer)
Dim I As Integer
For I = Idx To UBound(Tablo) - 1
Tablo(I) = Tablo(I + 1)
Next
ReDim Preserve Tablo(I - 1)
End Sub
Michel
"Jacques" a écrit dans le message de
news:42fe4b5c$0$25038$Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est possible.
Merci d'avance, Jacques
Salut,
Voici ce que j'ai fait
Fais plusieurs tests sur des copies de tes répertoires
Démarre la fonction RechercheRépertoires à partir d'une feuille vierge (ou
qui n'a rien en colonne A)
Dans cette colonne s'inscriront les noms des répertoires effacés, histoire
de faire un suivi de ce qui s'est passé...
Le programme n'est pas en béton et peut certainement être amélioré
Bonne chance !
----------------------------------------------------------------------------
----------
Option Explicit
Private Tablo()
Private IndexTablo As Integer
'Macro de départ
Sub RechercheRépertoires()
Dim nbRep As Integer
Cells.ClearContents
Range("A1").Select
Range("A1") = "Répertoires supprimés"
Do
IndexTablo = 0
ReDim Tablo(0)
ListerRépertoires "C:Test" ' répertoire principal à rechercher
nbRep = UBound(Tablo)
EffacerRépertoiresVides
Loop While UBound(Tablo) <> nbRep
End Sub
'Remplir un tableau avec les répertoires
Private Sub ListerRépertoires(FilePath As Variant)
Dim Fichier As Variant
Dim Liste As Collection
On Error GoTo Erreur
If Right(FilePath, 1) <> "" Then
FilePath = FilePath & ""
End If
Set Liste = New Collection
Fichier = Dir(FilePath & "*.*", vbDirectory + vbHidden + vbSystem)
While Fichier > ""
If GetAttr(FilePath & Fichier) And vbDirectory Then
If Left(Fichier, 1) <> "." Then
Liste.Add FilePath & Fichier
ReDim Preserve Tablo(IndexTablo)
Tablo(IndexTablo) = FilePath & Fichier & ""
IndexTablo = IndexTablo + 1
End If
End If
Fichier = Dir
DoEvents
Wend
For Each Fichier In Liste
ListerRépertoires Fichier
DoEvents
Next
Set Liste = Nothing
Exit Sub
Erreur:
MsgBox Err.Number & vbCrLf & Err.Description
End Sub
'Scanner tous les répertoires notés dans le tableau
Sub EffacerRépertoiresVides()
Dim I As Integer, DerniereLigne As Integer
Dim Fichier, SousRep, Trouvé As Boolean
On Error GoTo Erreur
For I = 0 To UBound(Tablo)
Trouvé = False
If I > UBound(Tablo) Then Exit Sub
'vérifier si un sous-répertoire est présent
SousRep = Dir(Tablo(I) & "*.*", vbDirectory + vbHidden + vbSystem)
While SousRep > ""
If GetAttr(Tablo(I) & SousRep) And vbDirectory Then
If Left(SousRep, 1) <> "." Then
Trouvé = True 'un sous-répertoire est présent
End If
End If
SousRep = Dir
Wend
Fichier = Dir(Tablo(I) & "*.*")
If Fichier = "" And Not Trouvé Then
DerniereLigne = Range("A65536").End(xlUp).Row + 1
RmDir Tablo(I) 'effacer le répertoire
Range("A" & DerniereLigne) = Tablo(I)
EnleverÉlément I
End If
Next
Exit Sub
Erreur:
MsgBox Err.Description
End Sub
'Enlever le nom du répertoire supprimé du tableau
Sub EnleverÉlément(Idx As Integer)
Dim I As Integer
For I = Idx To UBound(Tablo) - 1
Tablo(I) = Tablo(I + 1)
Next
ReDim Preserve Tablo(I - 1)
End Sub
Michel
"Jacques" <jacques-zeziola@wanadoo.fr> a écrit dans le message de
news:42fe4b5c$0$25038$8fcfb975@news.wanadoo.fr...
Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est possible.
Merci d'avance, Jacques
Salut,
Voici ce que j'ai fait
Fais plusieurs tests sur des copies de tes répertoires
Démarre la fonction RechercheRépertoires à partir d'une feuille vierge (ou
qui n'a rien en colonne A)
Dans cette colonne s'inscriront les noms des répertoires effacés, histoire
de faire un suivi de ce qui s'est passé...
Le programme n'est pas en béton et peut certainement être amélioré
Bonne chance !
----------------------------------------------------------------------------
----------
Option Explicit
Private Tablo()
Private IndexTablo As Integer
'Macro de départ
Sub RechercheRépertoires()
Dim nbRep As Integer
Cells.ClearContents
Range("A1").Select
Range("A1") = "Répertoires supprimés"
Do
IndexTablo = 0
ReDim Tablo(0)
ListerRépertoires "C:Test" ' répertoire principal à rechercher
nbRep = UBound(Tablo)
EffacerRépertoiresVides
Loop While UBound(Tablo) <> nbRep
End Sub
'Remplir un tableau avec les répertoires
Private Sub ListerRépertoires(FilePath As Variant)
Dim Fichier As Variant
Dim Liste As Collection
On Error GoTo Erreur
If Right(FilePath, 1) <> "" Then
FilePath = FilePath & ""
End If
Set Liste = New Collection
Fichier = Dir(FilePath & "*.*", vbDirectory + vbHidden + vbSystem)
While Fichier > ""
If GetAttr(FilePath & Fichier) And vbDirectory Then
If Left(Fichier, 1) <> "." Then
Liste.Add FilePath & Fichier
ReDim Preserve Tablo(IndexTablo)
Tablo(IndexTablo) = FilePath & Fichier & ""
IndexTablo = IndexTablo + 1
End If
End If
Fichier = Dir
DoEvents
Wend
For Each Fichier In Liste
ListerRépertoires Fichier
DoEvents
Next
Set Liste = Nothing
Exit Sub
Erreur:
MsgBox Err.Number & vbCrLf & Err.Description
End Sub
'Scanner tous les répertoires notés dans le tableau
Sub EffacerRépertoiresVides()
Dim I As Integer, DerniereLigne As Integer
Dim Fichier, SousRep, Trouvé As Boolean
On Error GoTo Erreur
For I = 0 To UBound(Tablo)
Trouvé = False
If I > UBound(Tablo) Then Exit Sub
'vérifier si un sous-répertoire est présent
SousRep = Dir(Tablo(I) & "*.*", vbDirectory + vbHidden + vbSystem)
While SousRep > ""
If GetAttr(Tablo(I) & SousRep) And vbDirectory Then
If Left(SousRep, 1) <> "." Then
Trouvé = True 'un sous-répertoire est présent
End If
End If
SousRep = Dir
Wend
Fichier = Dir(Tablo(I) & "*.*")
If Fichier = "" And Not Trouvé Then
DerniereLigne = Range("A65536").End(xlUp).Row + 1
RmDir Tablo(I) 'effacer le répertoire
Range("A" & DerniereLigne) = Tablo(I)
EnleverÉlément I
End If
Next
Exit Sub
Erreur:
MsgBox Err.Description
End Sub
'Enlever le nom du répertoire supprimé du tableau
Sub EnleverÉlément(Idx As Integer)
Dim I As Integer
For I = Idx To UBound(Tablo) - 1
Tablo(I) = Tablo(I + 1)
Next
ReDim Preserve Tablo(I - 1)
End Sub
Michel
"Jacques" a écrit dans le message de
news:42fe4b5c$0$25038$Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est possible.
Merci d'avance, Jacques
Michel (mPI)
J'ai utilisé ton code, cela fonctionne (J'ai fait quelques teste avec des
sous dossier un peu dans tous les sens vides ou non vides), j'en suis a
rajouter la fonction de MichDenis pour rechercher u dossier car le mien
n'est pas forcément fixe.
Je plante sur une erreur 450
Voili, voilou, Merci, Jacques
"MPi" a écrit dans le message de news:
jTGLe.7$Salut,
Voici ce que j'ai fait
Fais plusieurs tests sur des copies de tes répertoires
Démarre la fonction RechercheRépertoires à partir d'une feuille vierge
(ou
qui n'a rien en colonne A)
Dans cette colonne s'inscriront les noms des répertoires effacés,
histoire
de faire un suivi de ce qui s'est passé...
Le programme n'est pas en béton et peut certainement être amélioré
Bonne chance !
--------------------------------------------------------------------------
--
----------
Option Explicit
Private Tablo()
Private IndexTablo As Integer
'Macro de départ
Sub RechercheRépertoires()
Dim nbRep As Integer
Cells.ClearContents
Range("A1").Select
Range("A1") = "Répertoires supprimés"
Do
IndexTablo = 0
ReDim Tablo(0)
ListerRépertoires "C:Test" ' répertoire principal à rechercher
nbRep = UBound(Tablo)
EffacerRépertoiresVides
Loop While UBound(Tablo) <> nbRep
End Sub
'Remplir un tableau avec les répertoires
Private Sub ListerRépertoires(FilePath As Variant)
Dim Fichier As Variant
Dim Liste As Collection
On Error GoTo Erreur
If Right(FilePath, 1) <> "" Then
FilePath = FilePath & ""
End If
Set Liste = New Collection
Fichier = Dir(FilePath & "*.*", vbDirectory + vbHidden + vbSystem)
While Fichier > ""
If GetAttr(FilePath & Fichier) And vbDirectory Then
If Left(Fichier, 1) <> "." Then
Liste.Add FilePath & Fichier
ReDim Preserve Tablo(IndexTablo)
Tablo(IndexTablo) = FilePath & Fichier & ""
IndexTablo = IndexTablo + 1
End If
End If
Fichier = Dir
DoEvents
Wend
For Each Fichier In Liste
ListerRépertoires Fichier
DoEvents
Next
Set Liste = Nothing
Exit Sub
Erreur:
MsgBox Err.Number & vbCrLf & Err.Description
End Sub
'Scanner tous les répertoires notés dans le tableau
Sub EffacerRépertoiresVides()
Dim I As Integer, DerniereLigne As Integer
Dim Fichier, SousRep, Trouvé As Boolean
On Error GoTo Erreur
For I = 0 To UBound(Tablo)
Trouvé = False
If I > UBound(Tablo) Then Exit Sub
'vérifier si un sous-répertoire est présent
SousRep = Dir(Tablo(I) & "*.*", vbDirectory + vbHidden +
vbSystem)
While SousRep > ""
If GetAttr(Tablo(I) & SousRep) And vbDirectory Then
If Left(SousRep, 1) <> "." Then
Trouvé = True 'un sous-répertoire est présent
End If
End If
SousRep = Dir
Wend
Fichier = Dir(Tablo(I) & "*.*")
If Fichier = "" And Not Trouvé Then
DerniereLigne = Range("A65536").End(xlUp).Row + 1
RmDir Tablo(I) 'effacer le répertoire
Range("A" & DerniereLigne) = Tablo(I)
EnleverÉlément I
End If
Next
Exit Sub
Erreur:
MsgBox Err.Description
End Sub
'Enlever le nom du répertoire supprimé du tableau
Sub EnleverÉlément(Idx As Integer)
Dim I As Integer
For I = Idx To UBound(Tablo) - 1
Tablo(I) = Tablo(I + 1)
Next
ReDim Preserve Tablo(I - 1)
End Sub
Michel
"Jacques" a écrit dans le message de
news:42fe4b5c$0$25038$Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est
possible.
Merci d'avance, Jacques
Michel (mPI)
J'ai utilisé ton code, cela fonctionne (J'ai fait quelques teste avec des
sous dossier un peu dans tous les sens vides ou non vides), j'en suis a
rajouter la fonction de MichDenis pour rechercher u dossier car le mien
n'est pas forcément fixe.
Je plante sur une erreur 450
Voili, voilou, Merci, Jacques
"MPi" <m_pare@supprimer.videotron.ca> a écrit dans le message de news:
jTGLe.7$sX3.4918@wagner.videotron.net...
Salut,
Voici ce que j'ai fait
Fais plusieurs tests sur des copies de tes répertoires
Démarre la fonction RechercheRépertoires à partir d'une feuille vierge
(ou
qui n'a rien en colonne A)
Dans cette colonne s'inscriront les noms des répertoires effacés,
histoire
de faire un suivi de ce qui s'est passé...
Le programme n'est pas en béton et peut certainement être amélioré
Bonne chance !
--------------------------------------------------------------------------
--
----------
Option Explicit
Private Tablo()
Private IndexTablo As Integer
'Macro de départ
Sub RechercheRépertoires()
Dim nbRep As Integer
Cells.ClearContents
Range("A1").Select
Range("A1") = "Répertoires supprimés"
Do
IndexTablo = 0
ReDim Tablo(0)
ListerRépertoires "C:Test" ' répertoire principal à rechercher
nbRep = UBound(Tablo)
EffacerRépertoiresVides
Loop While UBound(Tablo) <> nbRep
End Sub
'Remplir un tableau avec les répertoires
Private Sub ListerRépertoires(FilePath As Variant)
Dim Fichier As Variant
Dim Liste As Collection
On Error GoTo Erreur
If Right(FilePath, 1) <> "" Then
FilePath = FilePath & ""
End If
Set Liste = New Collection
Fichier = Dir(FilePath & "*.*", vbDirectory + vbHidden + vbSystem)
While Fichier > ""
If GetAttr(FilePath & Fichier) And vbDirectory Then
If Left(Fichier, 1) <> "." Then
Liste.Add FilePath & Fichier
ReDim Preserve Tablo(IndexTablo)
Tablo(IndexTablo) = FilePath & Fichier & ""
IndexTablo = IndexTablo + 1
End If
End If
Fichier = Dir
DoEvents
Wend
For Each Fichier In Liste
ListerRépertoires Fichier
DoEvents
Next
Set Liste = Nothing
Exit Sub
Erreur:
MsgBox Err.Number & vbCrLf & Err.Description
End Sub
'Scanner tous les répertoires notés dans le tableau
Sub EffacerRépertoiresVides()
Dim I As Integer, DerniereLigne As Integer
Dim Fichier, SousRep, Trouvé As Boolean
On Error GoTo Erreur
For I = 0 To UBound(Tablo)
Trouvé = False
If I > UBound(Tablo) Then Exit Sub
'vérifier si un sous-répertoire est présent
SousRep = Dir(Tablo(I) & "*.*", vbDirectory + vbHidden +
vbSystem)
While SousRep > ""
If GetAttr(Tablo(I) & SousRep) And vbDirectory Then
If Left(SousRep, 1) <> "." Then
Trouvé = True 'un sous-répertoire est présent
End If
End If
SousRep = Dir
Wend
Fichier = Dir(Tablo(I) & "*.*")
If Fichier = "" And Not Trouvé Then
DerniereLigne = Range("A65536").End(xlUp).Row + 1
RmDir Tablo(I) 'effacer le répertoire
Range("A" & DerniereLigne) = Tablo(I)
EnleverÉlément I
End If
Next
Exit Sub
Erreur:
MsgBox Err.Description
End Sub
'Enlever le nom du répertoire supprimé du tableau
Sub EnleverÉlément(Idx As Integer)
Dim I As Integer
For I = Idx To UBound(Tablo) - 1
Tablo(I) = Tablo(I + 1)
Next
ReDim Preserve Tablo(I - 1)
End Sub
Michel
"Jacques" <jacques-zeziola@wanadoo.fr> a écrit dans le message de
news:42fe4b5c$0$25038$8fcfb975@news.wanadoo.fr...
Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est
possible.
Merci d'avance, Jacques
Michel (mPI)
J'ai utilisé ton code, cela fonctionne (J'ai fait quelques teste avec des
sous dossier un peu dans tous les sens vides ou non vides), j'en suis a
rajouter la fonction de MichDenis pour rechercher u dossier car le mien
n'est pas forcément fixe.
Je plante sur une erreur 450
Voili, voilou, Merci, Jacques
"MPi" a écrit dans le message de news:
jTGLe.7$Salut,
Voici ce que j'ai fait
Fais plusieurs tests sur des copies de tes répertoires
Démarre la fonction RechercheRépertoires à partir d'une feuille vierge
(ou
qui n'a rien en colonne A)
Dans cette colonne s'inscriront les noms des répertoires effacés,
histoire
de faire un suivi de ce qui s'est passé...
Le programme n'est pas en béton et peut certainement être amélioré
Bonne chance !
--------------------------------------------------------------------------
--
----------
Option Explicit
Private Tablo()
Private IndexTablo As Integer
'Macro de départ
Sub RechercheRépertoires()
Dim nbRep As Integer
Cells.ClearContents
Range("A1").Select
Range("A1") = "Répertoires supprimés"
Do
IndexTablo = 0
ReDim Tablo(0)
ListerRépertoires "C:Test" ' répertoire principal à rechercher
nbRep = UBound(Tablo)
EffacerRépertoiresVides
Loop While UBound(Tablo) <> nbRep
End Sub
'Remplir un tableau avec les répertoires
Private Sub ListerRépertoires(FilePath As Variant)
Dim Fichier As Variant
Dim Liste As Collection
On Error GoTo Erreur
If Right(FilePath, 1) <> "" Then
FilePath = FilePath & ""
End If
Set Liste = New Collection
Fichier = Dir(FilePath & "*.*", vbDirectory + vbHidden + vbSystem)
While Fichier > ""
If GetAttr(FilePath & Fichier) And vbDirectory Then
If Left(Fichier, 1) <> "." Then
Liste.Add FilePath & Fichier
ReDim Preserve Tablo(IndexTablo)
Tablo(IndexTablo) = FilePath & Fichier & ""
IndexTablo = IndexTablo + 1
End If
End If
Fichier = Dir
DoEvents
Wend
For Each Fichier In Liste
ListerRépertoires Fichier
DoEvents
Next
Set Liste = Nothing
Exit Sub
Erreur:
MsgBox Err.Number & vbCrLf & Err.Description
End Sub
'Scanner tous les répertoires notés dans le tableau
Sub EffacerRépertoiresVides()
Dim I As Integer, DerniereLigne As Integer
Dim Fichier, SousRep, Trouvé As Boolean
On Error GoTo Erreur
For I = 0 To UBound(Tablo)
Trouvé = False
If I > UBound(Tablo) Then Exit Sub
'vérifier si un sous-répertoire est présent
SousRep = Dir(Tablo(I) & "*.*", vbDirectory + vbHidden +
vbSystem)
While SousRep > ""
If GetAttr(Tablo(I) & SousRep) And vbDirectory Then
If Left(SousRep, 1) <> "." Then
Trouvé = True 'un sous-répertoire est présent
End If
End If
SousRep = Dir
Wend
Fichier = Dir(Tablo(I) & "*.*")
If Fichier = "" And Not Trouvé Then
DerniereLigne = Range("A65536").End(xlUp).Row + 1
RmDir Tablo(I) 'effacer le répertoire
Range("A" & DerniereLigne) = Tablo(I)
EnleverÉlément I
End If
Next
Exit Sub
Erreur:
MsgBox Err.Description
End Sub
'Enlever le nom du répertoire supprimé du tableau
Sub EnleverÉlément(Idx As Integer)
Dim I As Integer
For I = Idx To UBound(Tablo) - 1
Tablo(I) = Tablo(I + 1)
Next
ReDim Preserve Tablo(I - 1)
End Sub
Michel
"Jacques" a écrit dans le message de
news:42fe4b5c$0$25038$Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est
possible.
Merci d'avance, Jacques
Salut,
Voici ce que j'ai fait
Fais plusieurs tests sur des copies de tes répertoires
Démarre la fonction RechercheRépertoires à partir d'une feuille vierge (ou
qui n'a rien en colonne A)
Dans cette colonne s'inscriront les noms des répertoires effacés, histoire
de faire un suivi de ce qui s'est passé...
Le programme n'est pas en béton et peut certainement être amélioré
Bonne chance !
----------------------------------------------------------------------------
----------
Option Explicit
Private Tablo()
Private IndexTablo As Integer
'Macro de départ
Sub RechercheRépertoires()
Dim nbRep As Integer
Cells.ClearContents
Range("A1").Select
Range("A1") = "Répertoires supprimés"
Do
IndexTablo = 0
ReDim Tablo(0)
ListerRépertoires "C:Test" ' répertoire principal à rechercher
nbRep = UBound(Tablo)
EffacerRépertoiresVides
Loop While UBound(Tablo) <> nbRep
End Sub
'Remplir un tableau avec les répertoires
Private Sub ListerRépertoires(FilePath As Variant)
Dim Fichier As Variant
Dim Liste As Collection
On Error GoTo Erreur
If Right(FilePath, 1) <> "" Then
FilePath = FilePath & ""
End If
Set Liste = New Collection
Fichier = Dir(FilePath & "*.*", vbDirectory + vbHidden + vbSystem)
While Fichier > ""
If GetAttr(FilePath & Fichier) And vbDirectory Then
If Left(Fichier, 1) <> "." Then
Liste.Add FilePath & Fichier
ReDim Preserve Tablo(IndexTablo)
Tablo(IndexTablo) = FilePath & Fichier & ""
IndexTablo = IndexTablo + 1
End If
End If
Fichier = Dir
DoEvents
Wend
For Each Fichier In Liste
ListerRépertoires Fichier
DoEvents
Next
Set Liste = Nothing
Exit Sub
Erreur:
MsgBox Err.Number & vbCrLf & Err.Description
End Sub
'Scanner tous les répertoires notés dans le tableau
Sub EffacerRépertoiresVides()
Dim I As Integer, DerniereLigne As Integer
Dim Fichier, SousRep, Trouvé As Boolean
On Error GoTo Erreur
For I = 0 To UBound(Tablo)
Trouvé = False
If I > UBound(Tablo) Then Exit Sub
'vérifier si un sous-répertoire est présent
SousRep = Dir(Tablo(I) & "*.*", vbDirectory + vbHidden + vbSystem)
While SousRep > ""
If GetAttr(Tablo(I) & SousRep) And vbDirectory Then
If Left(SousRep, 1) <> "." Then
Trouvé = True 'un sous-répertoire est présent
End If
End If
SousRep = Dir
Wend
Fichier = Dir(Tablo(I) & "*.*")
If Fichier = "" And Not Trouvé Then
DerniereLigne = Range("A65536").End(xlUp).Row + 1
RmDir Tablo(I) 'effacer le répertoire
Range("A" & DerniereLigne) = Tablo(I)
EnleverÉlément I
End If
Next
Exit Sub
Erreur:
MsgBox Err.Description
End Sub
'Enlever le nom du répertoire supprimé du tableau
Sub EnleverÉlément(Idx As Integer)
Dim I As Integer
For I = Idx To UBound(Tablo) - 1
Tablo(I) = Tablo(I + 1)
Next
ReDim Preserve Tablo(I - 1)
End Sub
Michel
"Jacques" a écrit dans le message de
news:42fe4b5c$0$25038$Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est possible.
Merci d'avance, Jacques
Salut,
Voici ce que j'ai fait
Fais plusieurs tests sur des copies de tes répertoires
Démarre la fonction RechercheRépertoires à partir d'une feuille vierge (ou
qui n'a rien en colonne A)
Dans cette colonne s'inscriront les noms des répertoires effacés, histoire
de faire un suivi de ce qui s'est passé...
Le programme n'est pas en béton et peut certainement être amélioré
Bonne chance !
----------------------------------------------------------------------------
----------
Option Explicit
Private Tablo()
Private IndexTablo As Integer
'Macro de départ
Sub RechercheRépertoires()
Dim nbRep As Integer
Cells.ClearContents
Range("A1").Select
Range("A1") = "Répertoires supprimés"
Do
IndexTablo = 0
ReDim Tablo(0)
ListerRépertoires "C:Test" ' répertoire principal à rechercher
nbRep = UBound(Tablo)
EffacerRépertoiresVides
Loop While UBound(Tablo) <> nbRep
End Sub
'Remplir un tableau avec les répertoires
Private Sub ListerRépertoires(FilePath As Variant)
Dim Fichier As Variant
Dim Liste As Collection
On Error GoTo Erreur
If Right(FilePath, 1) <> "" Then
FilePath = FilePath & ""
End If
Set Liste = New Collection
Fichier = Dir(FilePath & "*.*", vbDirectory + vbHidden + vbSystem)
While Fichier > ""
If GetAttr(FilePath & Fichier) And vbDirectory Then
If Left(Fichier, 1) <> "." Then
Liste.Add FilePath & Fichier
ReDim Preserve Tablo(IndexTablo)
Tablo(IndexTablo) = FilePath & Fichier & ""
IndexTablo = IndexTablo + 1
End If
End If
Fichier = Dir
DoEvents
Wend
For Each Fichier In Liste
ListerRépertoires Fichier
DoEvents
Next
Set Liste = Nothing
Exit Sub
Erreur:
MsgBox Err.Number & vbCrLf & Err.Description
End Sub
'Scanner tous les répertoires notés dans le tableau
Sub EffacerRépertoiresVides()
Dim I As Integer, DerniereLigne As Integer
Dim Fichier, SousRep, Trouvé As Boolean
On Error GoTo Erreur
For I = 0 To UBound(Tablo)
Trouvé = False
If I > UBound(Tablo) Then Exit Sub
'vérifier si un sous-répertoire est présent
SousRep = Dir(Tablo(I) & "*.*", vbDirectory + vbHidden + vbSystem)
While SousRep > ""
If GetAttr(Tablo(I) & SousRep) And vbDirectory Then
If Left(SousRep, 1) <> "." Then
Trouvé = True 'un sous-répertoire est présent
End If
End If
SousRep = Dir
Wend
Fichier = Dir(Tablo(I) & "*.*")
If Fichier = "" And Not Trouvé Then
DerniereLigne = Range("A65536").End(xlUp).Row + 1
RmDir Tablo(I) 'effacer le répertoire
Range("A" & DerniereLigne) = Tablo(I)
EnleverÉlément I
End If
Next
Exit Sub
Erreur:
MsgBox Err.Description
End Sub
'Enlever le nom du répertoire supprimé du tableau
Sub EnleverÉlément(Idx As Integer)
Dim I As Integer
For I = Idx To UBound(Tablo) - 1
Tablo(I) = Tablo(I + 1)
Next
ReDim Preserve Tablo(I - 1)
End Sub
Michel
"Jacques" <jacques-zeziola@wanadoo.fr> a écrit dans le message de
news:42fe4b5c$0$25038$8fcfb975@news.wanadoo.fr...
Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est possible.
Merci d'avance, Jacques
Salut,
Voici ce que j'ai fait
Fais plusieurs tests sur des copies de tes répertoires
Démarre la fonction RechercheRépertoires à partir d'une feuille vierge (ou
qui n'a rien en colonne A)
Dans cette colonne s'inscriront les noms des répertoires effacés, histoire
de faire un suivi de ce qui s'est passé...
Le programme n'est pas en béton et peut certainement être amélioré
Bonne chance !
----------------------------------------------------------------------------
----------
Option Explicit
Private Tablo()
Private IndexTablo As Integer
'Macro de départ
Sub RechercheRépertoires()
Dim nbRep As Integer
Cells.ClearContents
Range("A1").Select
Range("A1") = "Répertoires supprimés"
Do
IndexTablo = 0
ReDim Tablo(0)
ListerRépertoires "C:Test" ' répertoire principal à rechercher
nbRep = UBound(Tablo)
EffacerRépertoiresVides
Loop While UBound(Tablo) <> nbRep
End Sub
'Remplir un tableau avec les répertoires
Private Sub ListerRépertoires(FilePath As Variant)
Dim Fichier As Variant
Dim Liste As Collection
On Error GoTo Erreur
If Right(FilePath, 1) <> "" Then
FilePath = FilePath & ""
End If
Set Liste = New Collection
Fichier = Dir(FilePath & "*.*", vbDirectory + vbHidden + vbSystem)
While Fichier > ""
If GetAttr(FilePath & Fichier) And vbDirectory Then
If Left(Fichier, 1) <> "." Then
Liste.Add FilePath & Fichier
ReDim Preserve Tablo(IndexTablo)
Tablo(IndexTablo) = FilePath & Fichier & ""
IndexTablo = IndexTablo + 1
End If
End If
Fichier = Dir
DoEvents
Wend
For Each Fichier In Liste
ListerRépertoires Fichier
DoEvents
Next
Set Liste = Nothing
Exit Sub
Erreur:
MsgBox Err.Number & vbCrLf & Err.Description
End Sub
'Scanner tous les répertoires notés dans le tableau
Sub EffacerRépertoiresVides()
Dim I As Integer, DerniereLigne As Integer
Dim Fichier, SousRep, Trouvé As Boolean
On Error GoTo Erreur
For I = 0 To UBound(Tablo)
Trouvé = False
If I > UBound(Tablo) Then Exit Sub
'vérifier si un sous-répertoire est présent
SousRep = Dir(Tablo(I) & "*.*", vbDirectory + vbHidden + vbSystem)
While SousRep > ""
If GetAttr(Tablo(I) & SousRep) And vbDirectory Then
If Left(SousRep, 1) <> "." Then
Trouvé = True 'un sous-répertoire est présent
End If
End If
SousRep = Dir
Wend
Fichier = Dir(Tablo(I) & "*.*")
If Fichier = "" And Not Trouvé Then
DerniereLigne = Range("A65536").End(xlUp).Row + 1
RmDir Tablo(I) 'effacer le répertoire
Range("A" & DerniereLigne) = Tablo(I)
EnleverÉlément I
End If
Next
Exit Sub
Erreur:
MsgBox Err.Description
End Sub
'Enlever le nom du répertoire supprimé du tableau
Sub EnleverÉlément(Idx As Integer)
Dim I As Integer
For I = Idx To UBound(Tablo) - 1
Tablo(I) = Tablo(I + 1)
Next
ReDim Preserve Tablo(I - 1)
End Sub
Michel
"Jacques" a écrit dans le message de
news:42fe4b5c$0$25038$Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est possible.
Merci d'avance, Jacques
Bonjour Jacques,
| supprimer normalement tous dossiers vide suite a un trie de tag et
rename,
| et a un retriage par une macro d'excel, qui me renvoie tous mes fichiers
a
| leur place, et supprime les dossiers vide (Fait par un internaute).
La procédure proposée n'a jamais pris soin de supprimer quelques
répertoires vides que ce soit... cet élément ne fut jamais stipulé
dans la question. Elle se contentait de détruire (commande inhibée) les
fichiers qui avaient été copiés vers un autre répertoire
afin que tu puisses tester la procédure sécuritairement.
Voici une adaptation de la même procédure qui déplace les fichiers désirés
vers un autre répertoire et supprime le répertoire source
désigné si ce dernier est vide. Prend soin lors des premières exécutions
(test) d'avoir une copie ailleurs du répertoire source en
cas de pépin.
'--------------------------------------------------
Sub DeplacerMP3_SelonLeurDebit()
Dim sPath As String, Dest22050 As String
Dim Dest44100 As String, Debit As String
Dim p$, n$, oFile As Object
Dim objShell As Object, oFolder As Object
Dim Fs As Object
Dim F As Object
'Répertoire où sont les fichiers musicaux
sPath = "c:Music"
'Répertoire de destination pour débit 22050
'ce répertoire doit exister avant de lancer la macro
Dest22050 = "c:Music22050"
'Répertoir de destination pour débit de 44100
'ce répertoire doit exister avant de lancer la macro
Dest44100 = "c:Music44100"
If sPath = "" Then Exit Sub
If Dir(sPath, vbDirectory) = "" Then
MsgBox "Répertoire inexistant."
Exit Sub
End If
If Dir(Dest22050, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour 22050 inexistant."
Exit Sub
End If
If Dir(Dest44100, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour Dest44100 inexistant."
Exit Sub
End If
Set Fs = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.Namespace(CStr(sPath))
For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name
If Right$(n, 4) = ".mp3" Then
Debit = Left(oFolder.GetDetailsOf(oFile, 22), 3)
Select Case Left(oFolder.GetDetailsOf(oFile, 22), 3)
Case Is = "128"
'Rien ne se passe.. rien n'est prévu
Case Is = "192"
'rien ne se passe ...
Case Is = "320"
'Rien de prévue pour l'instant.
Case Is > "22,0" 'pour 22,050
Fs.MoveFile p, Dest22050 & n
Case Is > "44,1"
Fs.MoveFile p, Dest22050 & n
End Select
End If
Next
's'assurer que le répertoire est vide avant de le supprimer
Set F = Fs.GetFolder(sPath)
If F.SubFolders.Count = 0 And F.Files.Count = 0 Then
Fs.DeleteFile sPath
End If
Set Fs = Nothing: Set F = Nothing
Set oFolder = Nothing: Set objShell = Nothing
End Sub
'--------------------------------------------------
Salutations!
"Jacques" a écrit dans le message de news:
42fedde0$0$877$
MPi, le forum
Merci de ta réponse.
Le principe et bien cela.
Mes dossiers, on bien des fois un sous répertoir, qui peu contenir des
fichier, c'est trés rare, car en faite cette petite appli, me sert a
Mais il arrive que cette suppression n'ai pas lieu par une mauvaise
manipulation de ma part (A force de trier, des dossiers restent vide et je
ne peu le savoir, sauf en les regardant un par un dans l'explorateur (J'ai
prés de 3000 dossiers a vérifier).
Donc voila, le but.
Pour ce qui est du code, fait un copier / coller dans ton message.
Merci, Jacques
"MPi" a écrit dans le message de news:
H9xLe.66113$Salut,
C'est possible de le faire, mais ça comporte différents obstacles.
Il faut, d'une part, utiliser une fonction récursive, mais aussi faire
attention de ne pas effacer un répertoire qui ne contient pas de fichier
mais qui contient un sous-répertoire qui, lui, contient des fichiers...
J'ai monté un petit programme qui semble fonctionner mais qu'il faut tout
de
même tester sur des répertoires bidons.
Le processus consiste à lister tous les répertoires.
Ensuite, il suffit de boucler ces répertoires et effacer tous ceux qui
n'ont
pas de fichier ni de sous-répertoire
Je ne sais pas si je dois attacher le fichier à mon message, inscrire le
code directement dans le corps du message ou le déposer à un endroit
queconque (?)
J'utilise Outlook Express
Michel
"Jacques" a écrit dans le message de
news:42fe4b5c$0$25038$Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est
possible.
Merci d'avance, Jacques
Bonjour Jacques,
| supprimer normalement tous dossiers vide suite a un trie de tag et
rename,
| et a un retriage par une macro d'excel, qui me renvoie tous mes fichiers
a
| leur place, et supprime les dossiers vide (Fait par un internaute).
La procédure proposée n'a jamais pris soin de supprimer quelques
répertoires vides que ce soit... cet élément ne fut jamais stipulé
dans la question. Elle se contentait de détruire (commande inhibée) les
fichiers qui avaient été copiés vers un autre répertoire
afin que tu puisses tester la procédure sécuritairement.
Voici une adaptation de la même procédure qui déplace les fichiers désirés
vers un autre répertoire et supprime le répertoire source
désigné si ce dernier est vide. Prend soin lors des premières exécutions
(test) d'avoir une copie ailleurs du répertoire source en
cas de pépin.
'--------------------------------------------------
Sub DeplacerMP3_SelonLeurDebit()
Dim sPath As String, Dest22050 As String
Dim Dest44100 As String, Debit As String
Dim p$, n$, oFile As Object
Dim objShell As Object, oFolder As Object
Dim Fs As Object
Dim F As Object
'Répertoire où sont les fichiers musicaux
sPath = "c:Music"
'Répertoire de destination pour débit 22050
'ce répertoire doit exister avant de lancer la macro
Dest22050 = "c:Music22050"
'Répertoir de destination pour débit de 44100
'ce répertoire doit exister avant de lancer la macro
Dest44100 = "c:Music44100"
If sPath = "" Then Exit Sub
If Dir(sPath, vbDirectory) = "" Then
MsgBox "Répertoire inexistant."
Exit Sub
End If
If Dir(Dest22050, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour 22050 inexistant."
Exit Sub
End If
If Dir(Dest44100, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour Dest44100 inexistant."
Exit Sub
End If
Set Fs = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.Namespace(CStr(sPath))
For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name
If Right$(n, 4) = ".mp3" Then
Debit = Left(oFolder.GetDetailsOf(oFile, 22), 3)
Select Case Left(oFolder.GetDetailsOf(oFile, 22), 3)
Case Is = "128"
'Rien ne se passe.. rien n'est prévu
Case Is = "192"
'rien ne se passe ...
Case Is = "320"
'Rien de prévue pour l'instant.
Case Is > "22,0" 'pour 22,050
Fs.MoveFile p, Dest22050 & n
Case Is > "44,1"
Fs.MoveFile p, Dest22050 & n
End Select
End If
Next
's'assurer que le répertoire est vide avant de le supprimer
Set F = Fs.GetFolder(sPath)
If F.SubFolders.Count = 0 And F.Files.Count = 0 Then
Fs.DeleteFile sPath
End If
Set Fs = Nothing: Set F = Nothing
Set oFolder = Nothing: Set objShell = Nothing
End Sub
'--------------------------------------------------
Salutations!
"Jacques" <jacques-zeziola@wanadoo.fr> a écrit dans le message de news:
42fedde0$0$877$8fcfb975@news.wanadoo.fr...
MPi, le forum
Merci de ta réponse.
Le principe et bien cela.
Mes dossiers, on bien des fois un sous répertoir, qui peu contenir des
fichier, c'est trés rare, car en faite cette petite appli, me sert a
Mais il arrive que cette suppression n'ai pas lieu par une mauvaise
manipulation de ma part (A force de trier, des dossiers restent vide et je
ne peu le savoir, sauf en les regardant un par un dans l'explorateur (J'ai
prés de 3000 dossiers a vérifier).
Donc voila, le but.
Pour ce qui est du code, fait un copier / coller dans ton message.
Merci, Jacques
"MPi" <m_pare@supprimer.videotron.ca> a écrit dans le message de news:
H9xLe.66113$pX4.854727@weber.videotron.net...
Salut,
C'est possible de le faire, mais ça comporte différents obstacles.
Il faut, d'une part, utiliser une fonction récursive, mais aussi faire
attention de ne pas effacer un répertoire qui ne contient pas de fichier
mais qui contient un sous-répertoire qui, lui, contient des fichiers...
J'ai monté un petit programme qui semble fonctionner mais qu'il faut tout
de
même tester sur des répertoires bidons.
Le processus consiste à lister tous les répertoires.
Ensuite, il suffit de boucler ces répertoires et effacer tous ceux qui
n'ont
pas de fichier ni de sous-répertoire
Je ne sais pas si je dois attacher le fichier à mon message, inscrire le
code directement dans le corps du message ou le déposer à un endroit
queconque (?)
J'utilise Outlook Express
Michel
"Jacques" <jacques-zeziola@wanadoo.fr> a écrit dans le message de
news:42fe4b5c$0$25038$8fcfb975@news.wanadoo.fr...
Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est
possible.
Merci d'avance, Jacques
Bonjour Jacques,
| supprimer normalement tous dossiers vide suite a un trie de tag et
rename,
| et a un retriage par une macro d'excel, qui me renvoie tous mes fichiers
a
| leur place, et supprime les dossiers vide (Fait par un internaute).
La procédure proposée n'a jamais pris soin de supprimer quelques
répertoires vides que ce soit... cet élément ne fut jamais stipulé
dans la question. Elle se contentait de détruire (commande inhibée) les
fichiers qui avaient été copiés vers un autre répertoire
afin que tu puisses tester la procédure sécuritairement.
Voici une adaptation de la même procédure qui déplace les fichiers désirés
vers un autre répertoire et supprime le répertoire source
désigné si ce dernier est vide. Prend soin lors des premières exécutions
(test) d'avoir une copie ailleurs du répertoire source en
cas de pépin.
'--------------------------------------------------
Sub DeplacerMP3_SelonLeurDebit()
Dim sPath As String, Dest22050 As String
Dim Dest44100 As String, Debit As String
Dim p$, n$, oFile As Object
Dim objShell As Object, oFolder As Object
Dim Fs As Object
Dim F As Object
'Répertoire où sont les fichiers musicaux
sPath = "c:Music"
'Répertoire de destination pour débit 22050
'ce répertoire doit exister avant de lancer la macro
Dest22050 = "c:Music22050"
'Répertoir de destination pour débit de 44100
'ce répertoire doit exister avant de lancer la macro
Dest44100 = "c:Music44100"
If sPath = "" Then Exit Sub
If Dir(sPath, vbDirectory) = "" Then
MsgBox "Répertoire inexistant."
Exit Sub
End If
If Dir(Dest22050, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour 22050 inexistant."
Exit Sub
End If
If Dir(Dest44100, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour Dest44100 inexistant."
Exit Sub
End If
Set Fs = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.Namespace(CStr(sPath))
For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name
If Right$(n, 4) = ".mp3" Then
Debit = Left(oFolder.GetDetailsOf(oFile, 22), 3)
Select Case Left(oFolder.GetDetailsOf(oFile, 22), 3)
Case Is = "128"
'Rien ne se passe.. rien n'est prévu
Case Is = "192"
'rien ne se passe ...
Case Is = "320"
'Rien de prévue pour l'instant.
Case Is > "22,0" 'pour 22,050
Fs.MoveFile p, Dest22050 & n
Case Is > "44,1"
Fs.MoveFile p, Dest22050 & n
End Select
End If
Next
's'assurer que le répertoire est vide avant de le supprimer
Set F = Fs.GetFolder(sPath)
If F.SubFolders.Count = 0 And F.Files.Count = 0 Then
Fs.DeleteFile sPath
End If
Set Fs = Nothing: Set F = Nothing
Set oFolder = Nothing: Set objShell = Nothing
End Sub
'--------------------------------------------------
Salutations!
"Jacques" a écrit dans le message de news:
42fedde0$0$877$
MPi, le forum
Merci de ta réponse.
Le principe et bien cela.
Mes dossiers, on bien des fois un sous répertoir, qui peu contenir des
fichier, c'est trés rare, car en faite cette petite appli, me sert a
Mais il arrive que cette suppression n'ai pas lieu par une mauvaise
manipulation de ma part (A force de trier, des dossiers restent vide et je
ne peu le savoir, sauf en les regardant un par un dans l'explorateur (J'ai
prés de 3000 dossiers a vérifier).
Donc voila, le but.
Pour ce qui est du code, fait un copier / coller dans ton message.
Merci, Jacques
"MPi" a écrit dans le message de news:
H9xLe.66113$Salut,
C'est possible de le faire, mais ça comporte différents obstacles.
Il faut, d'une part, utiliser une fonction récursive, mais aussi faire
attention de ne pas effacer un répertoire qui ne contient pas de fichier
mais qui contient un sous-répertoire qui, lui, contient des fichiers...
J'ai monté un petit programme qui semble fonctionner mais qu'il faut tout
de
même tester sur des répertoires bidons.
Le processus consiste à lister tous les répertoires.
Ensuite, il suffit de boucler ces répertoires et effacer tous ceux qui
n'ont
pas de fichier ni de sous-répertoire
Je ne sais pas si je dois attacher le fichier à mon message, inscrire le
code directement dans le corps du message ou le déposer à un endroit
queconque (?)
J'utilise Outlook Express
Michel
"Jacques" a écrit dans le message de
news:42fe4b5c$0$25038$Salut a toutes et tous
Voila j'ai un dossier qui possède des dossiers dont des fichiers on été
supprimé (A peu prés 700 dossier sur 3000 enregistrés).
Donc Dossier source ->Sous dossier (Vide ou plein)-> Sous-sous dossiers
(Vide ou plein)
Donc ce que je recherche c'est une macro qui m'analyserai ce dossier
principale et dés quelle trouve un sous dossier vides, quelle le
supprime.
J'espère que ma question et assez claire et si surtout cela est
possible.
Merci d'avance, Jacques
