Recherche de dossiers vide et les supp

Bonjour Jacques,

| Il me déplace un fichier dans le dossier 44,1 et a priori cela change
l'extention.

Si tu prenais le temps de m'expliquer ...tout ça c'est du chinois ! Je lis
le chinois mais je ne le comprends pas !!!


Salutations!




"Jacques" a écrit dans le message de news:
430059fe$0$1255$
Michel denis,

J'ai réssayé ton code, toujours pareil.
Il me déplace un fichier dans le dossier 44,1 et a priori cela change
l'extention.

Merci encore, Jacques
"michdenis" a écrit dans le message de news:

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,

| Il me déplace un fichier dans le dossier 44,1 et a priori cela change
l'extention.

Si tu prenais le temps de m'expliquer ...tout ça c'est du chinois ! Je lis
le chinois mais je ne le comprends pas !!!


Salutations!




"Jacques" a écrit dans le message de news:
430059fe$0$1255$
Michel denis,

J'ai réssayé ton code, toujours pareil.
Il me déplace un fichier dans le dossier 44,1 et a priori cela change
l'extention.

Merci encore, Jacques
"michdenis" a écrit dans le message de news:

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,

Voici , j'ai modifié légèrment la procédure pour la rendre insensible au
séparateur décimale.

J'ai retiré ceci : If Right$(n, 4) = ".mp3" Then
cependant note que si tu as des répertoires ou tu as des fichiers qui ont
différentes extentions, le tri pourrait être plus
difficile à faire ... selon l'échantillonnage.

Comment expliquer à partir de cette procédure, qu'un de tes fichiers aient
pu changer d'extentions, je n'en ai pas la moindre
idée...

Est-ce possible que tu aies des MP3 dont le taux d'échantillonnage n'a pas
été retenu ? Des "Case" au "Select Case", tu peux en
ajouter autant que tu désires avec un répertoire de destination propre
....

Tous les tests que j'ai effectué, seront avérés concluant. À toi
d'adapter, si tu travailles dans un environnement différent.

Salutations!

'-------------------------------------------
Sub DeplacerMP3_SelonLeurDebit() 'Denis

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
Debit = Left(oFolder.GetDetailsOf(oFile, 22), 3)
Debit = WorksheetFunction.Substitute(Debit, ",", ".")
Select Case Left(oFolder.GetDetailsOf(oFile, 22), 3)
Case Is = "128"
Fs.MoveFile p, Dest22050 & n
'Rien ne se passe.. rien n'est prévu

Case Is = "192"
Fs.MoveFile p, Dest22050 & n
'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" ' pour 44,100
Fs.MoveFile p, Dest44100 & n
End Select
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
'----------------------------------------




"Jacques" a écrit dans le message de news:
4300cc02$0$3134$
Michdenis

Excuses-moi, mais il est vrai que je ne veux pas non plus trop t'embéter
avec cela.

Donc, J'ai créer un dossier, dans lequel j'ai mis deux sous dossier et
deux
fichier en MP3 ( 1 en 22,050 et un en 44,100).

J'ai modifier la destination dans le code, pour mon cas, car je ne stocke
rien sous C:)
Ce qui donne :

'Répertoire où sont les fichiers musicaux
sPath = "i:Music"

'Répertoire de destination pour débit 22050
'ce répertoire doit exister avant de lancer la macro
Dest22050 = "i:Music22050"

'Répertoir de destination pour débit de 44100
'ce répertoire doit exister avant de lancer la macro
Dest44100 = "i:Music44100"

J'ai supprimé la ligne de code que tu m'avais dit :

If Right$(n, 4) = ".mp3" Then

et le End If associé.

Ensuite je lance la procédure : DeplacerMP3_SelonLeurDebit

Il ne se passe plus rien, et j'y comprends plus rien, lol

Voici le code dans le module :



Sub MP3_Listing_Modifier()

Dim sPath As String
Dim Dest44100, Dest22050 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 = "I:Music" 'à déterminer

'Répertoire de destination pour 192
'ce répertoire doit exister avant de lancer la macro
Dest44100 = "I:Music44100" 'à déterminer

'Répertoir de destination pour au dela de 40000
'ce répertoire doit exister avant de lancer la macro
Dest22050 = "I:Music22050" 'à déterminer

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 22,050 Khz inexistant."
Exit Sub
End If
If Dir(Dest44100, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour 44,100 Khz inexistant."
Exit Sub
End If

Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.Namespace(CStr(sPath))

For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name

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"
'FileCopy p, Dest192 & n
'La commande pour détruire le fichier original
'a été désactivé ...teste avant pour voir !!!
'Kill p
Case Is = "320"
'Rien de prévue pour l'instant.

Case Is > "22,0" 'pour 22,050
FileCopy p, Dest22050 & n
'Kill p

Case Is > "44,1"
FileCopy p, Dest44100 & n
'Kill p
End Select
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

Merci beaucoup, Jacques
"michdenis" a écrit dans le message de news:
%23gq$

Bonjour Jacques,

| Il me déplace un fichier dans le dossier 44,1 et a priori cela change
l'extention.

Si tu prenais le temps de m'expliquer ...tout ça c'est du chinois ! Je
lis
le chinois mais je ne le comprends pas !!!


Salutations!




"Jacques" a écrit dans le message de news:
430059fe$0$1255$
Michel denis,

J'ai réssayé ton code, toujours pareil.
Il me déplace un fichier dans le dossier 44,1 et a priori cela change
l'extention.

Merci encore, Jacques
"michdenis" a écrit dans le message de news:

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

MichDenis

Merci, encore.

Donc voila, j'ai fait un test, et voici le résultat :

Donc il y a deux fichier de chaque taux (44,100 et 22,050)

Les deux fichiers en 44,100, on été se mettre dans le dossier prévu pour
les 22,050 en modifiant quelque chose dans l'extension et se sont bien
supprimé du dossier de départ. Les deux fichiers en 22,050 sont resté a
leur place dans le dossier "Music".

Merci, Jacques


"michdenis" a écrit dans le message de news:

Bonjour Jacques,

Voici , j'ai modifié légèrment la procédure pour la rendre insensible au
séparateur décimale.

J'ai retiré ceci : If Right$(n, 4) = ".mp3" Then
cependant note que si tu as des répertoires ou tu as des fichiers qui ont
différentes extentions, le tri pourrait être plus
difficile à faire ... selon l'échantillonnage.

Comment expliquer à partir de cette procédure, qu'un de tes fichiers
aient pu changer d'extentions, je n'en ai pas la moindre
idée...

Est-ce possible que tu aies des MP3 dont le taux d'échantillonnage n'a
pas été retenu ? Des "Case" au "Select Case", tu peux en
ajouter autant que tu désires avec un répertoire de destination propre
....

Tous les tests que j'ai effectué, seront avérés concluant. À toi
d'adapter, si tu travailles dans un environnement différent.

Salutations!

'-------------------------------------------
Sub DeplacerMP3_SelonLeurDebit() 'Denis

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
Debit = Left(oFolder.GetDetailsOf(oFile, 22), 3)
Debit = WorksheetFunction.Substitute(Debit, ",", ".")
Select Case Left(oFolder.GetDetailsOf(oFile, 22), 3)
Case Is = "128"
Fs.MoveFile p, Dest22050 & n
'Rien ne se passe.. rien n'est prévu

Case Is = "192"
Fs.MoveFile p, Dest22050 & n
'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" ' pour 44,100
Fs.MoveFile p, Dest44100 & n
End Select
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
'----------------------------------------




"Jacques" a écrit dans le message de news:
4300cc02$0$3134$
Michdenis

Excuses-moi, mais il est vrai que je ne veux pas non plus trop t'embéter
avec cela.

Donc, J'ai créer un dossier, dans lequel j'ai mis deux sous dossier et
deux
fichier en MP3 ( 1 en 22,050 et un en 44,100).

J'ai modifier la destination dans le code, pour mon cas, car je ne stocke
rien sous C:)
Ce qui donne :

'Répertoire où sont les fichiers musicaux
sPath = "i:Music"

'Répertoire de destination pour débit 22050
'ce répertoire doit exister avant de lancer la macro
Dest22050 = "i:Music22050"

'Répertoir de destination pour débit de 44100
'ce répertoire doit exister avant de lancer la macro
Dest44100 = "i:Music44100"

J'ai supprimé la ligne de code que tu m'avais dit :

If Right$(n, 4) = ".mp3" Then

et le End If associé.

Ensuite je lance la procédure : DeplacerMP3_SelonLeurDebit

Il ne se passe plus rien, et j'y comprends plus rien, lol

Voici le code dans le module :



Sub MP3_Listing_Modifier()

Dim sPath As String
Dim Dest44100, Dest22050 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 = "I:Music" 'à déterminer

'Répertoire de destination pour 192
'ce répertoire doit exister avant de lancer la macro
Dest44100 = "I:Music44100" 'à déterminer

'Répertoir de destination pour au dela de 40000
'ce répertoire doit exister avant de lancer la macro
Dest22050 = "I:Music22050" 'à déterminer

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 22,050 Khz inexistant."
Exit Sub
End If
If Dir(Dest44100, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour 44,100 Khz inexistant."
Exit Sub
End If

Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.Namespace(CStr(sPath))

For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name

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"
'FileCopy p, Dest192 & n
'La commande pour détruire le fichier original
'a été désactivé ...teste avant pour voir !!!
'Kill p
Case Is = "320"
'Rien de prévue pour l'instant.

Case Is > "22,0" 'pour 22,050
FileCopy p, Dest22050 & n
'Kill p

Case Is > "44,1"
FileCopy p, Dest44100 & n
'Kill p
End Select
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

Merci beaucoup, Jacques
"michdenis" a écrit dans le message de news:
%23gq$

Bonjour Jacques,

| Il me déplace un fichier dans le dossier 44,1 et a priori cela change
l'extention.

Si tu prenais le temps de m'expliquer ...tout ça c'est du chinois ! Je
lis
le chinois mais je ne le comprends pas !!!


Salutations!




"Jacques" a écrit dans le message de news:
430059fe$0$1255$
Michel denis,

J'ai réssayé ton code, toujours pareil.
Il me déplace un fichier dans le dossier 44,1 et a priori cela change
l'extention.

Merci encore, Jacques
"michdenis" a écrit dans le message de news:

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

MichDenis

Merci, encore.

Donc voila, j'ai fait un test, et voici le résultat :

Donc il y a deux fichier de chaque taux (44,100 et 22,050)

Les deux fichiers en 44,100, on été se mettre dans le dossier prévu pour
les 22,050 en modifiant quelque chose dans l'extension et se sont bien
supprimé du dossier de départ. Les deux fichiers en 22,050 sont resté a
leur place dans le dossier "Music".

Merci, Jacques


"michdenis" a écrit dans le message de news:

Bonjour Jacques,

Voici , j'ai modifié légèrment la procédure pour la rendre insensible au
séparateur décimale.

J'ai retiré ceci : If Right$(n, 4) = ".mp3" Then
cependant note que si tu as des répertoires ou tu as des fichiers qui ont
différentes extentions, le tri pourrait être plus
difficile à faire ... selon l'échantillonnage.

Comment expliquer à partir de cette procédure, qu'un de tes fichiers
aient pu changer d'extentions, je n'en ai pas la moindre
idée...

Est-ce possible que tu aies des MP3 dont le taux d'échantillonnage n'a
pas été retenu ? Des "Case" au "Select Case", tu peux en
ajouter autant que tu désires avec un répertoire de destination propre
....

Tous les tests que j'ai effectué, seront avérés concluant. À toi
d'adapter, si tu travailles dans un environnement différent.

Salutations!

'-------------------------------------------
Sub DeplacerMP3_SelonLeurDebit() 'Denis

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
Debit = Left(oFolder.GetDetailsOf(oFile, 22), 3)
Debit = WorksheetFunction.Substitute(Debit, ",", ".")
Select Case Left(oFolder.GetDetailsOf(oFile, 22), 3)
Case Is = "128"
Fs.MoveFile p, Dest22050 & n
'Rien ne se passe.. rien n'est prévu

Case Is = "192"
Fs.MoveFile p, Dest22050 & n
'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" ' pour 44,100
Fs.MoveFile p, Dest44100 & n
End Select
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
'----------------------------------------




"Jacques" a écrit dans le message de news:
4300cc02$0$3134$
Michdenis

Excuses-moi, mais il est vrai que je ne veux pas non plus trop t'embéter
avec cela.

Donc, J'ai créer un dossier, dans lequel j'ai mis deux sous dossier et
deux
fichier en MP3 ( 1 en 22,050 et un en 44,100).

J'ai modifier la destination dans le code, pour mon cas, car je ne stocke
rien sous C:)
Ce qui donne :

'Répertoire où sont les fichiers musicaux
sPath = "i:Music"

'Répertoire de destination pour débit 22050
'ce répertoire doit exister avant de lancer la macro
Dest22050 = "i:Music22050"

'Répertoir de destination pour débit de 44100
'ce répertoire doit exister avant de lancer la macro
Dest44100 = "i:Music44100"

J'ai supprimé la ligne de code que tu m'avais dit :

If Right$(n, 4) = ".mp3" Then

et le End If associé.

Ensuite je lance la procédure : DeplacerMP3_SelonLeurDebit

Il ne se passe plus rien, et j'y comprends plus rien, lol

Voici le code dans le module :



Sub MP3_Listing_Modifier()

Dim sPath As String
Dim Dest44100, Dest22050 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 = "I:Music" 'à déterminer

'Répertoire de destination pour 192
'ce répertoire doit exister avant de lancer la macro
Dest44100 = "I:Music44100" 'à déterminer

'Répertoir de destination pour au dela de 40000
'ce répertoire doit exister avant de lancer la macro
Dest22050 = "I:Music22050" 'à déterminer

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 22,050 Khz inexistant."
Exit Sub
End If
If Dir(Dest44100, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour 44,100 Khz inexistant."
Exit Sub
End If

Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.Namespace(CStr(sPath))

For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name

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"
'FileCopy p, Dest192 & n
'La commande pour détruire le fichier original
'a été désactivé ...teste avant pour voir !!!
'Kill p
Case Is = "320"
'Rien de prévue pour l'instant.

Case Is > "22,0" 'pour 22,050
FileCopy p, Dest22050 & n
'Kill p

Case Is > "44,1"
FileCopy p, Dest44100 & n
'Kill p
End Select
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

Merci beaucoup, Jacques
"michdenis" a écrit dans le message de news:
%23gq$

Bonjour Jacques,

| Il me déplace un fichier dans le dossier 44,1 et a priori cela change
l'extention.

Si tu prenais le temps de m'expliquer ...tout ça c'est du chinois ! Je
lis
le chinois mais je ne le comprends pas !!!


Salutations!




"Jacques" a écrit dans le message de news:
430059fe$0$1255$
Michel denis,

J'ai réssayé ton code, toujours pareil.
Il me déplace un fichier dans le dossier 44,1 et a priori cela change
l'extention.

Merci encore, Jacques
"michdenis" a écrit dans le message de news:

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,

Une dernière tentative ...

Es-ce qu'il serait possible de m'expilquer un peu cette partie de code,
car

le peu que j'ai compris (Si c'est bien ce que j'ai compris) :

Pour chaque fichier du répertoire que tu auras spécifié comme répertoire
source

For Each oFile In oFolder.Items
P = chemin du fichier + nom du fichier
N = Nom du fichier seulement
p = oFile.Path: n = oFile.Name

debit = Nom de la variable recueillant la donnée
Left( ;3) = extrait les 3 premiers chiffres de la données
Debit = Left(oFolder.GetDetailsOf(oFile, 22), 3)

'ceci remplace la virgule par le point afin d'éviter qu'il puisse y
avoir

'des difficultés de fonctionnement si les paramètres de windows
sont différents d'un ordinateur à l'autre
Debit = WorksheetFunction.Substitute(Debit, ",", ".")

'Tu devrais utiliser ceci à la place
Select Case Left(oFolder.GetDetailsOf(oFile, 22), 3)
'remplace par ceci :
Select Case Debit (le contenu de la variable est défini dans
' Les 2 lignes précédentes

| Tu recherche dans le dossier, le fichier avec le détail N° 22 qui est
le

| débit?

J'ai utilisé le terme taux d'échantillonnage au lieu de débit parce que
cela me semblait une expression plus juste. La propriété 33

retourne pour tous les MP3 44 khz qui est possiblement le taux
d'échantillonnage initiale au moment de la création de l'originale

(le fichier Wav) mais pas celui du fichier MP3 -> que tu l'appelles débit
ou taux d'échantillonnage, la réalité (chez moi) fait

référence à l'index 22 des propriétés.


Voila, si j'ai mal compris, fais le moi savoi (si tu peu, car je pense que
tu n'as pas que cela a faire)

Pour ce qui est de la modification des extensions des fichiers, cela était
dû au fait que dans la première procédure, au lieu de

déplacer les fichiers, tu les copiais et comme les extentions n'étaient
pas affichées dans ton explorateurs windows, le nom de la

copie du fichier créé n'avait pas d'extension ... il aurait fallu ajouter
une ligne de code pour prévoir cette éventualité.

Maintenant comme la procédure déplace les fichiers, cela n'est plus un
problème.

En espérant que cela t'aidera... c'était ma dernière intervention pour
cette question.

Bonne chance,


Salutations!






Merci, Jacques
"Jacques" a écrit dans le message de news:
430304bb$0$890$

MichDenis

Merci, encore.

Donc voila, j'ai fait un test, et voici le résultat :

Donc il y a deux fichier de chaque taux (44,100 et 22,050)

Les deux fichiers en 44,100, on été se mettre dans le dossier prévu pour
les 22,050 en modifiant quelque chose dans l'extension et se sont bien
supprimé du dossier de départ. Les deux fichiers en 22,050 sont resté a
leur place dans le dossier "Music".

Merci, Jacques


"michdenis" a écrit dans le message de news:

Bonjour Jacques,

Voici , j'ai modifié légèrment la procédure pour la rendre insensible
au

séparateur décimale.

J'ai retiré ceci : If Right$(n, 4) = ".mp3" Then
cependant note que si tu as des répertoires ou tu as des fichiers qui
ont

différentes extentions, le tri pourrait être plus
difficile à faire ... selon l'échantillonnage.

Comment expliquer à partir de cette procédure, qu'un de tes fichiers
aient pu changer d'extentions, je n'en ai pas la moindre
idée...

Est-ce possible que tu aies des MP3 dont le taux d'échantillonnage n'a
pas été retenu ? Des "Case" au "Select Case", tu peux en
ajouter autant que tu désires avec un répertoire de destination propre
....

Tous les tests que j'ai effectué, seront avérés concluant. À toi
d'adapter, si tu travailles dans un environnement différent.

Salutations!

'-------------------------------------------
Sub DeplacerMP3_SelonLeurDebit() 'Denis

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
Debit = Left(oFolder.GetDetailsOf(oFile, 22), 3)
Debit = WorksheetFunction.Substitute(Debit, ",", ".")
Select Case Left(oFolder.GetDetailsOf(oFile, 22), 3)
Case Is = "128"
Fs.MoveFile p, Dest22050 & n
'Rien ne se passe.. rien n'est prévu

Case Is = "192"
Fs.MoveFile p, Dest22050 & n
'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" ' pour 44,100
Fs.MoveFile p, Dest44100 & n
End Select
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
'----------------------------------------




"Jacques" a écrit dans le message de news:
4300cc02$0$3134$
Michdenis

Excuses-moi, mais il est vrai que je ne veux pas non plus trop
t'embéter

avec cela.

Donc, J'ai créer un dossier, dans lequel j'ai mis deux sous dossier et
deux
fichier en MP3 ( 1 en 22,050 et un en 44,100).

J'ai modifier la destination dans le code, pour mon cas, car je ne
stocke

rien sous C:)
Ce qui donne :

'Répertoire où sont les fichiers musicaux
sPath = "i:Music"

'Répertoire de destination pour débit 22050
'ce répertoire doit exister avant de lancer la macro
Dest22050 = "i:Music22050"

'Répertoir de destination pour débit de 44100
'ce répertoire doit exister avant de lancer la macro
Dest44100 = "i:Music44100"

J'ai supprimé la ligne de code que tu m'avais dit :

If Right$(n, 4) = ".mp3" Then

et le End If associé.

Ensuite je lance la procédure : DeplacerMP3_SelonLeurDebit

Il ne se passe plus rien, et j'y comprends plus rien, lol

Voici le code dans le module :



Sub MP3_Listing_Modifier()

Dim sPath As String
Dim Dest44100, Dest22050 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 = "I:Music" 'à déterminer

'Répertoire de destination pour 192
'ce répertoire doit exister avant de lancer la macro
Dest44100 = "I:Music44100" 'à déterminer

'Répertoir de destination pour au dela de 40000
'ce répertoire doit exister avant de lancer la macro
Dest22050 = "I:Music22050" 'à déterminer

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 22,050 Khz inexistant."
Exit Sub
End If
If Dir(Dest44100, vbDirectory) = "" Then
MsgBox "Répertoire de destinaton pour 44,100 Khz inexistant."
Exit Sub
End If

Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.Namespace(CStr(sPath))

For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name

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"
'FileCopy p, Dest192 & n
'La commande pour détruire le fichier original
'a été désactivé ...teste avant pour voir !!!
'Kill p
Case Is = "320"
'Rien de prévue pour l'instant.

Case Is > "22,0" 'pour 22,050
FileCopy p, Dest22050 & n
'Kill p

Case Is > "44,1"
FileCopy p, Dest44100 & n
'Kill p
End Select
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

Merci beaucoup, Jacques
"michdenis" a écrit dans le message de news:
%23gq$

Bonjour Jacques,

| Il me déplace un fichier dans le dossier 44,1 et a priori cela
change

l'extention.

Si tu prenais le temps de m'expliquer ...tout ça c'est du chinois ! Je
lis
le chinois mais je ne le comprends pas !!!


Salutations!




"Jacques" a écrit dans le message de
news:

430059fe$0$1255$
Michel denis,

J'ai réssayé ton code, toujours pareil.
Il me déplace un fichier dans le dossier 44,1 et a priori cela change
l'extention.

Merci encore, Jacques
"michdenis" a écrit dans le message de news:

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: