Un dernier détail, est-ce que ces informations sont disponibles pour tous
les MP3 indépendamment de la manière qu'ils ont été gravés
?
Si tu le peux, tu télécharges un MP3 du Net et tu testes la procédures !
Salutations!
"Jacques" a écrit dans le message de news:
42fb6947$0$3116$
Re
Je viens de réessayer, et cela me créer le classeur avec les entêtes, mais
rien dedans.
Donc je fais :
Je lance la procédure, je choisi un dossier qui possède 2 MP3 et c'est
tout.
Merci, Jacques
"Jacques" a écrit dans le message de news:
42f896d2$0$894$Salut a toutes et tous
Voila j'ai des fichiers de musiques, qui on été encodé a 22,050 au lieu
de
44,1.
Et il possible par VBA en séléctionnant le dossier source de faire une
recherche de tous les fichier en 44,1 et de les envoyer dans un un
dossier
déstination en gardant la structure du dossier source.
Si :
Dossier source->Dossier artistes-> Fichiers musiques (22,050 et 44,1)
Avoir Dossier destination-> Dossier artistes-> Fichier musiques (44,1)
Ou si cela est plus simple, supprimer tous les fichiers en 22,050 du
dossier source.
Je vous remercie d'avance.
Jacques
Un dernier détail, est-ce que ces informations sont disponibles pour tous
les MP3 indépendamment de la manière qu'ils ont été gravés
?
Si tu le peux, tu télécharges un MP3 du Net et tu testes la procédures !
Salutations!
"Jacques" <jacques-zeziola@wanadoo.fr> a écrit dans le message de news:
42fb6947$0$3116$8fcfb975@news.wanadoo.fr...
Re
Je viens de réessayer, et cela me créer le classeur avec les entêtes, mais
rien dedans.
Donc je fais :
Je lance la procédure, je choisi un dossier qui possède 2 MP3 et c'est
tout.
Merci, Jacques
"Jacques" <jacques-zeziola@wanadoo.fr> a écrit dans le message de news:
42f896d2$0$894$8fcfb975@news.wanadoo.fr...
Salut a toutes et tous
Voila j'ai des fichiers de musiques, qui on été encodé a 22,050 au lieu
de
44,1.
Et il possible par VBA en séléctionnant le dossier source de faire une
recherche de tous les fichier en 44,1 et de les envoyer dans un un
dossier
déstination en gardant la structure du dossier source.
Si :
Dossier source->Dossier artistes-> Fichiers musiques (22,050 et 44,1)
Avoir Dossier destination-> Dossier artistes-> Fichier musiques (44,1)
Ou si cela est plus simple, supprimer tous les fichiers en 22,050 du
dossier source.
Je vous remercie d'avance.
Jacques
Un dernier détail, est-ce que ces informations sont disponibles pour tous
les MP3 indépendamment de la manière qu'ils ont été gravés
?
Si tu le peux, tu télécharges un MP3 du Net et tu testes la procédures !
Salutations!
"Jacques" a écrit dans le message de news:
42fb6947$0$3116$
Re
Je viens de réessayer, et cela me créer le classeur avec les entêtes, mais
rien dedans.
Donc je fais :
Je lance la procédure, je choisi un dossier qui possède 2 MP3 et c'est
tout.
Merci, Jacques
"Jacques" a écrit dans le message de news:
42f896d2$0$894$Salut a toutes et tous
Voila j'ai des fichiers de musiques, qui on été encodé a 22,050 au lieu
de
44,1.
Et il possible par VBA en séléctionnant le dossier source de faire une
recherche de tous les fichier en 44,1 et de les envoyer dans un un
dossier
déstination en gardant la structure du dossier source.
Si :
Dossier source->Dossier artistes-> Fichiers musiques (22,050 et 44,1)
Avoir Dossier destination-> Dossier artistes-> Fichier musiques (44,1)
Ou si cela est plus simple, supprimer tous les fichiers en 22,050 du
dossier source.
Je vous remercie d'avance.
Jacques
Un dernier détail, est-ce que ces informations sont disponibles pour tous
les MP3 indépendamment de la manière qu'ils ont été gravés
?
Si tu le peux, tu télécharges un MP3 du Net et tu testes la procédures !
Salutations!
"Jacques" a écrit dans le message de news:
42fb6947$0$3116$
Re
Je viens de réessayer, et cela me créer le classeur avec les entêtes, mais
rien dedans.
Donc je fais :
Je lance la procédure, je choisi un dossier qui possède 2 MP3 et c'est
tout.
Merci, Jacques
"Jacques" a écrit dans le message de news:
42f896d2$0$894$Salut a toutes et tous
Voila j'ai des fichiers de musiques, qui on été encodé a 22,050 au lieu
de
44,1.
Et il possible par VBA en séléctionnant le dossier source de faire une
recherche de tous les fichier en 44,1 et de les envoyer dans un un
dossier
déstination en gardant la structure du dossier source.
Si :
Dossier source->Dossier artistes-> Fichiers musiques (22,050 et 44,1)
Avoir Dossier destination-> Dossier artistes-> Fichier musiques (44,1)
Ou si cela est plus simple, supprimer tous les fichiers en 22,050 du
dossier source.
Je vous remercie d'avance.
Jacques
Un dernier détail, est-ce que ces informations sont disponibles pour tous
les MP3 indépendamment de la manière qu'ils ont été gravés
?
Si tu le peux, tu télécharges un MP3 du Net et tu testes la procédures !
Salutations!
"Jacques" <jacques-zeziola@wanadoo.fr> a écrit dans le message de news:
42fb6947$0$3116$8fcfb975@news.wanadoo.fr...
Re
Je viens de réessayer, et cela me créer le classeur avec les entêtes, mais
rien dedans.
Donc je fais :
Je lance la procédure, je choisi un dossier qui possède 2 MP3 et c'est
tout.
Merci, Jacques
"Jacques" <jacques-zeziola@wanadoo.fr> a écrit dans le message de news:
42f896d2$0$894$8fcfb975@news.wanadoo.fr...
Salut a toutes et tous
Voila j'ai des fichiers de musiques, qui on été encodé a 22,050 au lieu
de
44,1.
Et il possible par VBA en séléctionnant le dossier source de faire une
recherche de tous les fichier en 44,1 et de les envoyer dans un un
dossier
déstination en gardant la structure du dossier source.
Si :
Dossier source->Dossier artistes-> Fichiers musiques (22,050 et 44,1)
Avoir Dossier destination-> Dossier artistes-> Fichier musiques (44,1)
Ou si cela est plus simple, supprimer tous les fichiers en 22,050 du
dossier source.
Je vous remercie d'avance.
Jacques
Un dernier détail, est-ce que ces informations sont disponibles pour tous
les MP3 indépendamment de la manière qu'ils ont été gravés
?
Si tu le peux, tu télécharges un MP3 du Net et tu testes la procédures !
Salutations!
"Jacques" a écrit dans le message de news:
42fb6947$0$3116$
Re
Je viens de réessayer, et cela me créer le classeur avec les entêtes, mais
rien dedans.
Donc je fais :
Je lance la procédure, je choisi un dossier qui possède 2 MP3 et c'est
tout.
Merci, Jacques
"Jacques" a écrit dans le message de news:
42f896d2$0$894$Salut a toutes et tous
Voila j'ai des fichiers de musiques, qui on été encodé a 22,050 au lieu
de
44,1.
Et il possible par VBA en séléctionnant le dossier source de faire une
recherche de tous les fichier en 44,1 et de les envoyer dans un un
dossier
déstination en gardant la structure du dossier source.
Si :
Dossier source->Dossier artistes-> Fichiers musiques (22,050 et 44,1)
Avoir Dossier destination-> Dossier artistes-> Fichier musiques (44,1)
Ou si cela est plus simple, supprimer tous les fichiers en 22,050 du
dossier source.
Je vous remercie d'avance.
Jacques
Salut a toutes et tous
Voila j'ai des fichiers de musiques, qui on été encodé a 22,050 au lieu de
44,1.
Et il possible par VBA en séléctionnant le dossier source de faire une
recherche de tous les fichier en 44,1 et de les envoyer dans un un dossier
déstination en gardant la structure du dossier source.
Si :
Dossier source->Dossier artistes-> Fichiers musiques (22,050 et 44,1)
Avoir Dossier destination-> Dossier artistes-> Fichier musiques (44,1)
Ou si cela est plus simple, supprimer tous les fichiers en 22,050 du
dossier source.
Je vous remercie d'avance.
Jacques
Salut a toutes et tous
Voila j'ai des fichiers de musiques, qui on été encodé a 22,050 au lieu de
44,1.
Et il possible par VBA en séléctionnant le dossier source de faire une
recherche de tous les fichier en 44,1 et de les envoyer dans un un dossier
déstination en gardant la structure du dossier source.
Si :
Dossier source->Dossier artistes-> Fichiers musiques (22,050 et 44,1)
Avoir Dossier destination-> Dossier artistes-> Fichier musiques (44,1)
Ou si cela est plus simple, supprimer tous les fichiers en 22,050 du
dossier source.
Je vous remercie d'avance.
Jacques
Salut a toutes et tous
Voila j'ai des fichiers de musiques, qui on été encodé a 22,050 au lieu de
44,1.
Et il possible par VBA en séléctionnant le dossier source de faire une
recherche de tous les fichier en 44,1 et de les envoyer dans un un dossier
déstination en gardant la structure du dossier source.
Si :
Dossier source->Dossier artistes-> Fichiers musiques (22,050 et 44,1)
Avoir Dossier destination-> Dossier artistes-> Fichier musiques (44,1)
Ou si cela est plus simple, supprimer tous les fichiers en 22,050 du
dossier source.
Je vous remercie d'avance.
Jacques
Salut a toutes et tous
Voila j'ai des fichiers de musiques, qui on été encodé a 22,050 au lieu de
44,1.
Et il possible par VBA en séléctionnant le dossier source de faire une
recherche de tous les fichier en 44,1 et de les envoyer dans un un dossier
déstination en gardant la structure du dossier source.
Si :
Dossier source->Dossier artistes-> Fichiers musiques (22,050 et 44,1)
Avoir Dossier destination-> Dossier artistes-> Fichier musiques (44,1)
Ou si cela est plus simple, supprimer tous les fichiers en 22,050 du
dossier source.
Je vous remercie d'avance.
Jacques
Salut a toutes et tous
Voila j'ai des fichiers de musiques, qui on été encodé a 22,050 au lieu de
44,1.
Et il possible par VBA en séléctionnant le dossier source de faire une
recherche de tous les fichier en 44,1 et de les envoyer dans un un dossier
déstination en gardant la structure du dossier source.
Si :
Dossier source->Dossier artistes-> Fichiers musiques (22,050 et 44,1)
Avoir Dossier destination-> Dossier artistes-> Fichier musiques (44,1)
Ou si cela est plus simple, supprimer tous les fichiers en 22,050 du
dossier source.
Je vous remercie d'avance.
Jacques
Salut a toutes et tous
Voila j'ai des fichiers de musiques, qui on été encodé a 22,050 au lieu de
44,1.
Et il possible par VBA en séléctionnant le dossier source de faire une
recherche de tous les fichier en 44,1 et de les envoyer dans un un dossier
déstination en gardant la structure du dossier source.
Si :
Dossier source->Dossier artistes-> Fichiers musiques (22,050 et 44,1)
Avoir Dossier destination-> Dossier artistes-> Fichier musiques (44,1)
Ou si cela est plus simple, supprimer tous les fichiers en 22,050 du
dossier source.
Je vous remercie d'avance.
Jacques
Bonjour Jacques,
Voici, je commente le code, tu devrais trouver toi-même ce qui ne vas pas
en exécutant pas à pas la procédure
Espérant que tu pourras t'y retrouver !
Salutations!
'---------------------------
Pour chaque fichier contenu dans le répertoire choisi
For Each oFile In oFolder.Items
P = Chemin complet & nom de fichier
N = Nom du fichier seulement
p = oFile.Path: n = oFile.Name
Debit = Left(oFolder.GetDetailsOf(oFile, 22), 3)
Debit = Taux d'échantillonnage du fichier examiné
22 = Numéro de la propriété retournant le taux d'échantillonage du
fichier
dans la méthode GetDetailsOf
La fonction Left( x, 3) extrait les 3 premiers caractères du taux
d'échantillonage
Attention selon les taux que tu m'as fourni : 22,050 et 44,100 dans la
question,
Sont-ils valides ? Est-ce que le séparateur des milliers sur ton
système est la virgule ou le point ? Cela est important dans le
select case qui suit. Lorsque tu exécutes en pas à pas, en plaçant le
curseur au dessus de debit... tu devrais obtenir ta réponse à
ces questions et adapter le select case de façon appropriée.
Le reste de cette procédure est un select case basé sur le taux
d'échantillonnage du fichier MP3 donné par cette ligne de code :
oFolder.GetDetailsOf(oFile, 22)
'Au lieu de cette ligne de code
Select Case Left(oFolder.GetDetailsOf(oFile, 22), 3)
'J'aurai du simplement écrire, puisque la variable est défini à la ligne
précédente.
Select Case Debit
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
FileCopy p, Dest22050 & n
'La commande pour détruire le fichier original
'a été désactivé ...teste avant pour voir !!!
'Kill p
Case Is > "44,1"
FileCopy p, Dest44100 & n
'La commande pour détruire le fichier original
'a été désactivé ...teste avant pour voir !!!
'Kill p
End Select
End If
Next
'---------------------------
Copie des 2 procédures :
**********************************************************************
Copier des MP3 vers un autre répertoire
selon leur taux d'échantillonnage
'-----------------------------------------
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
'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 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
FileCopy p, Dest22050 & n
'La commande pour détruire le fichier original
'a été désactivé ...teste avant pour voir !!!
'Kill p
Case Is > "44,1"
FileCopy p, Dest44100 & n
'La commande pour détruire le fichier original
'a été désactivé ...teste avant pour voir !!!
'Kill p
End Select
End If
Next
Set oFolder = Nothing: Set objShell = Nothing
End Sub
'-----------------------------------------
**********************************************************************
Lister Les attributs DesFichier MP3 dans un
Nouveau classeur Excel.
Sub MP3_Listing()
Dim sPath As String: sPath = GetShellFolder
If sPath = "" Then Exit Sub
If Dir(sPath, vbDirectory) = "" Then Exit Sub
Dim Headers(35), x%, y&, i&, p$, n$, oFile As Object
Dim objShell As Object, oFolder As Object
Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.Namespace(CStr(sPath))
Application.ScreenUpdating = False
Workbooks.Add
For i = 0 To 34
Headers(i) = oFolder.GetDetailsOf(oFolder.Items, i)
Select Case i
Case 0 To 1, 10, 12, 14 To 18, 20 To 22
x = x + 1
Cells(1, x) = Headers(i)
End Select
Next
y = 1
For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name
If Right$(n, 4) = ".mp3" Then
x = 0: y = y + 1
For i = 0 To 34
Select Case i
Case 0 To 1, 10, 12, 14 To 18, 20 To 22
x = x + 1
Cells(y, x) = oFolder.GetDetailsOf(oFile, i)
With ActiveSheet
.Hyperlinks.Add .Range("A" & y), Hlink(p), , n, n
End With
End Select
Next
End If
Next
Range("A2").Select
ActiveWindow.FreezePanes = True
Rows("1:1").Font.Bold = True
Cells.Columns.AutoFit
Range("A1").Select
Set oFolder = Nothing: Set objShell = Nothing
End Sub
'-----------------------------------------
Private Function GetShellFolder() As String
Const Title = "Sélectionnez un répertoire !"
Dim oSHA As Object, oSF As Object, oItem As Object
On Error GoTo 1
Set oSHA = CreateObject("Shell.Application")
Set oSF = oSHA.BrowseForFolder(0, Title, &H1 Or &H10, &H11)
If InStr(TypeName(oSF), "Folder") <> 1 Then Exit Function
For Each oItem In oSF.parentfolder.Items
If oItem.Name = oSF.Title Then
GetShellFolder = oItem.Path
Exit Function
End If
Next
GetShellFolder = oSF.Title
Set oSF = Nothing: Set oSHA = Nothing
Exit Function
1: MsgBox "Error: " & Err.Number & vbLf & Err.Description, 48
End Function
'-----------------------------------------
Private Function Hlink(p As String) As String
Hlink = "file:///" & Replace(Replace(p, " ", "%20"), "", "/")
End Function
"Jacques" a écrit dans le message de news:
42fc3eab$0$3133$
Michel Denis
Merci
J'ai apporté les modifications que tu m'as dit.
Le premier fichier, fonction trés bien, 'ex-ce qu'il est dure de rajouter
une colonne pour le taux d'échantillonage, car je n'arrive pas a
comprendre
comment sont récupéré ces infos, pas excel.
Le second, me met tout dans le dossier 44100.
Merci beaucoup, Jacques
"Jacques" a écrit dans le message de news:
42f896d2$0$894$Salut a toutes et tous
Voila j'ai des fichiers de musiques, qui on été encodé a 22,050 au lieu
de
44,1.
Et il possible par VBA en séléctionnant le dossier source de faire une
recherche de tous les fichier en 44,1 et de les envoyer dans un un
dossier
déstination en gardant la structure du dossier source.
Si :
Dossier source->Dossier artistes-> Fichiers musiques (22,050 et 44,1)
Avoir Dossier destination-> Dossier artistes-> Fichier musiques (44,1)
Ou si cela est plus simple, supprimer tous les fichiers en 22,050 du
dossier source.
Je vous remercie d'avance.
Jacques
Bonjour Jacques,
Voici, je commente le code, tu devrais trouver toi-même ce qui ne vas pas
en exécutant pas à pas la procédure
Espérant que tu pourras t'y retrouver !
Salutations!
'---------------------------
Pour chaque fichier contenu dans le répertoire choisi
For Each oFile In oFolder.Items
P = Chemin complet & nom de fichier
N = Nom du fichier seulement
p = oFile.Path: n = oFile.Name
Debit = Left(oFolder.GetDetailsOf(oFile, 22), 3)
Debit = Taux d'échantillonnage du fichier examiné
22 = Numéro de la propriété retournant le taux d'échantillonage du
fichier
dans la méthode GetDetailsOf
La fonction Left( x, 3) extrait les 3 premiers caractères du taux
d'échantillonage
Attention selon les taux que tu m'as fourni : 22,050 et 44,100 dans la
question,
Sont-ils valides ? Est-ce que le séparateur des milliers sur ton
système est la virgule ou le point ? Cela est important dans le
select case qui suit. Lorsque tu exécutes en pas à pas, en plaçant le
curseur au dessus de debit... tu devrais obtenir ta réponse à
ces questions et adapter le select case de façon appropriée.
Le reste de cette procédure est un select case basé sur le taux
d'échantillonnage du fichier MP3 donné par cette ligne de code :
oFolder.GetDetailsOf(oFile, 22)
'Au lieu de cette ligne de code
Select Case Left(oFolder.GetDetailsOf(oFile, 22), 3)
'J'aurai du simplement écrire, puisque la variable est défini à la ligne
précédente.
Select Case Debit
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
FileCopy p, Dest22050 & n
'La commande pour détruire le fichier original
'a été désactivé ...teste avant pour voir !!!
'Kill p
Case Is > "44,1"
FileCopy p, Dest44100 & n
'La commande pour détruire le fichier original
'a été désactivé ...teste avant pour voir !!!
'Kill p
End Select
End If
Next
'---------------------------
Copie des 2 procédures :
**********************************************************************
Copier des MP3 vers un autre répertoire
selon leur taux d'échantillonnage
'-----------------------------------------
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
'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 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
FileCopy p, Dest22050 & n
'La commande pour détruire le fichier original
'a été désactivé ...teste avant pour voir !!!
'Kill p
Case Is > "44,1"
FileCopy p, Dest44100 & n
'La commande pour détruire le fichier original
'a été désactivé ...teste avant pour voir !!!
'Kill p
End Select
End If
Next
Set oFolder = Nothing: Set objShell = Nothing
End Sub
'-----------------------------------------
**********************************************************************
Lister Les attributs DesFichier MP3 dans un
Nouveau classeur Excel.
Sub MP3_Listing()
Dim sPath As String: sPath = GetShellFolder
If sPath = "" Then Exit Sub
If Dir(sPath, vbDirectory) = "" Then Exit Sub
Dim Headers(35), x%, y&, i&, p$, n$, oFile As Object
Dim objShell As Object, oFolder As Object
Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.Namespace(CStr(sPath))
Application.ScreenUpdating = False
Workbooks.Add
For i = 0 To 34
Headers(i) = oFolder.GetDetailsOf(oFolder.Items, i)
Select Case i
Case 0 To 1, 10, 12, 14 To 18, 20 To 22
x = x + 1
Cells(1, x) = Headers(i)
End Select
Next
y = 1
For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name
If Right$(n, 4) = ".mp3" Then
x = 0: y = y + 1
For i = 0 To 34
Select Case i
Case 0 To 1, 10, 12, 14 To 18, 20 To 22
x = x + 1
Cells(y, x) = oFolder.GetDetailsOf(oFile, i)
With ActiveSheet
.Hyperlinks.Add .Range("A" & y), Hlink(p), , n, n
End With
End Select
Next
End If
Next
Range("A2").Select
ActiveWindow.FreezePanes = True
Rows("1:1").Font.Bold = True
Cells.Columns.AutoFit
Range("A1").Select
Set oFolder = Nothing: Set objShell = Nothing
End Sub
'-----------------------------------------
Private Function GetShellFolder() As String
Const Title = "Sélectionnez un répertoire !"
Dim oSHA As Object, oSF As Object, oItem As Object
On Error GoTo 1
Set oSHA = CreateObject("Shell.Application")
Set oSF = oSHA.BrowseForFolder(0, Title, &H1 Or &H10, &H11)
If InStr(TypeName(oSF), "Folder") <> 1 Then Exit Function
For Each oItem In oSF.parentfolder.Items
If oItem.Name = oSF.Title Then
GetShellFolder = oItem.Path
Exit Function
End If
Next
GetShellFolder = oSF.Title
Set oSF = Nothing: Set oSHA = Nothing
Exit Function
1: MsgBox "Error: " & Err.Number & vbLf & Err.Description, 48
End Function
'-----------------------------------------
Private Function Hlink(p As String) As String
Hlink = "file:///" & Replace(Replace(p, " ", "%20"), "", "/")
End Function
"Jacques" <jacques-zeziola@wanadoo.fr> a écrit dans le message de news:
42fc3eab$0$3133$8fcfb975@news.wanadoo.fr...
Michel Denis
Merci
J'ai apporté les modifications que tu m'as dit.
Le premier fichier, fonction trés bien, 'ex-ce qu'il est dure de rajouter
une colonne pour le taux d'échantillonage, car je n'arrive pas a
comprendre
comment sont récupéré ces infos, pas excel.
Le second, me met tout dans le dossier 44100.
Merci beaucoup, Jacques
"Jacques" <jacques-zeziola@wanadoo.fr> a écrit dans le message de news:
42f896d2$0$894$8fcfb975@news.wanadoo.fr...
Salut a toutes et tous
Voila j'ai des fichiers de musiques, qui on été encodé a 22,050 au lieu
de
44,1.
Et il possible par VBA en séléctionnant le dossier source de faire une
recherche de tous les fichier en 44,1 et de les envoyer dans un un
dossier
déstination en gardant la structure du dossier source.
Si :
Dossier source->Dossier artistes-> Fichiers musiques (22,050 et 44,1)
Avoir Dossier destination-> Dossier artistes-> Fichier musiques (44,1)
Ou si cela est plus simple, supprimer tous les fichiers en 22,050 du
dossier source.
Je vous remercie d'avance.
Jacques
Bonjour Jacques,
Voici, je commente le code, tu devrais trouver toi-même ce qui ne vas pas
en exécutant pas à pas la procédure
Espérant que tu pourras t'y retrouver !
Salutations!
'---------------------------
Pour chaque fichier contenu dans le répertoire choisi
For Each oFile In oFolder.Items
P = Chemin complet & nom de fichier
N = Nom du fichier seulement
p = oFile.Path: n = oFile.Name
Debit = Left(oFolder.GetDetailsOf(oFile, 22), 3)
Debit = Taux d'échantillonnage du fichier examiné
22 = Numéro de la propriété retournant le taux d'échantillonage du
fichier
dans la méthode GetDetailsOf
La fonction Left( x, 3) extrait les 3 premiers caractères du taux
d'échantillonage
Attention selon les taux que tu m'as fourni : 22,050 et 44,100 dans la
question,
Sont-ils valides ? Est-ce que le séparateur des milliers sur ton
système est la virgule ou le point ? Cela est important dans le
select case qui suit. Lorsque tu exécutes en pas à pas, en plaçant le
curseur au dessus de debit... tu devrais obtenir ta réponse à
ces questions et adapter le select case de façon appropriée.
Le reste de cette procédure est un select case basé sur le taux
d'échantillonnage du fichier MP3 donné par cette ligne de code :
oFolder.GetDetailsOf(oFile, 22)
'Au lieu de cette ligne de code
Select Case Left(oFolder.GetDetailsOf(oFile, 22), 3)
'J'aurai du simplement écrire, puisque la variable est défini à la ligne
précédente.
Select Case Debit
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
FileCopy p, Dest22050 & n
'La commande pour détruire le fichier original
'a été désactivé ...teste avant pour voir !!!
'Kill p
Case Is > "44,1"
FileCopy p, Dest44100 & n
'La commande pour détruire le fichier original
'a été désactivé ...teste avant pour voir !!!
'Kill p
End Select
End If
Next
'---------------------------
Copie des 2 procédures :
**********************************************************************
Copier des MP3 vers un autre répertoire
selon leur taux d'échantillonnage
'-----------------------------------------
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
'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 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
FileCopy p, Dest22050 & n
'La commande pour détruire le fichier original
'a été désactivé ...teste avant pour voir !!!
'Kill p
Case Is > "44,1"
FileCopy p, Dest44100 & n
'La commande pour détruire le fichier original
'a été désactivé ...teste avant pour voir !!!
'Kill p
End Select
End If
Next
Set oFolder = Nothing: Set objShell = Nothing
End Sub
'-----------------------------------------
**********************************************************************
Lister Les attributs DesFichier MP3 dans un
Nouveau classeur Excel.
Sub MP3_Listing()
Dim sPath As String: sPath = GetShellFolder
If sPath = "" Then Exit Sub
If Dir(sPath, vbDirectory) = "" Then Exit Sub
Dim Headers(35), x%, y&, i&, p$, n$, oFile As Object
Dim objShell As Object, oFolder As Object
Set objShell = CreateObject("Shell.Application")
Set oFolder = objShell.Namespace(CStr(sPath))
Application.ScreenUpdating = False
Workbooks.Add
For i = 0 To 34
Headers(i) = oFolder.GetDetailsOf(oFolder.Items, i)
Select Case i
Case 0 To 1, 10, 12, 14 To 18, 20 To 22
x = x + 1
Cells(1, x) = Headers(i)
End Select
Next
y = 1
For Each oFile In oFolder.Items
p = oFile.Path: n = oFile.Name
If Right$(n, 4) = ".mp3" Then
x = 0: y = y + 1
For i = 0 To 34
Select Case i
Case 0 To 1, 10, 12, 14 To 18, 20 To 22
x = x + 1
Cells(y, x) = oFolder.GetDetailsOf(oFile, i)
With ActiveSheet
.Hyperlinks.Add .Range("A" & y), Hlink(p), , n, n
End With
End Select
Next
End If
Next
Range("A2").Select
ActiveWindow.FreezePanes = True
Rows("1:1").Font.Bold = True
Cells.Columns.AutoFit
Range("A1").Select
Set oFolder = Nothing: Set objShell = Nothing
End Sub
'-----------------------------------------
Private Function GetShellFolder() As String
Const Title = "Sélectionnez un répertoire !"
Dim oSHA As Object, oSF As Object, oItem As Object
On Error GoTo 1
Set oSHA = CreateObject("Shell.Application")
Set oSF = oSHA.BrowseForFolder(0, Title, &H1 Or &H10, &H11)
If InStr(TypeName(oSF), "Folder") <> 1 Then Exit Function
For Each oItem In oSF.parentfolder.Items
If oItem.Name = oSF.Title Then
GetShellFolder = oItem.Path
Exit Function
End If
Next
GetShellFolder = oSF.Title
Set oSF = Nothing: Set oSHA = Nothing
Exit Function
1: MsgBox "Error: " & Err.Number & vbLf & Err.Description, 48
End Function
'-----------------------------------------
Private Function Hlink(p As String) As String
Hlink = "file:///" & Replace(Replace(p, " ", "%20"), "", "/")
End Function
"Jacques" a écrit dans le message de news:
42fc3eab$0$3133$
Michel Denis
Merci
J'ai apporté les modifications que tu m'as dit.
Le premier fichier, fonction trés bien, 'ex-ce qu'il est dure de rajouter
une colonne pour le taux d'échantillonage, car je n'arrive pas a
comprendre
comment sont récupéré ces infos, pas excel.
Le second, me met tout dans le dossier 44100.
Merci beaucoup, Jacques
"Jacques" a écrit dans le message de news:
42f896d2$0$894$Salut a toutes et tous
Voila j'ai des fichiers de musiques, qui on été encodé a 22,050 au lieu
de
44,1.
Et il possible par VBA en séléctionnant le dossier source de faire une
recherche de tous les fichier en 44,1 et de les envoyer dans un un
dossier
déstination en gardant la structure du dossier source.
Si :
Dossier source->Dossier artistes-> Fichiers musiques (22,050 et 44,1)
Avoir Dossier destination-> Dossier artistes-> Fichier musiques (44,1)
Ou si cela est plus simple, supprimer tous les fichiers en 22,050 du
dossier source.
Je vous remercie d'avance.
Jacques
Salut a toutes et tous
Voila j'ai des fichiers de musiques, qui on été encodé a 22,050 au lieu de
44,1.
Et il possible par VBA en séléctionnant le dossier source de faire une
recherche de tous les fichier en 44,1 et de les envoyer dans un un dossier
déstination en gardant la structure du dossier source.
Si :
Dossier source->Dossier artistes-> Fichiers musiques (22,050 et 44,1)
Avoir Dossier destination-> Dossier artistes-> Fichier musiques (44,1)
Ou si cela est plus simple, supprimer tous les fichiers en 22,050 du
dossier source.
Je vous remercie d'avance.
Jacques
Salut a toutes et tous
Voila j'ai des fichiers de musiques, qui on été encodé a 22,050 au lieu de
44,1.
Et il possible par VBA en séléctionnant le dossier source de faire une
recherche de tous les fichier en 44,1 et de les envoyer dans un un dossier
déstination en gardant la structure du dossier source.
Si :
Dossier source->Dossier artistes-> Fichiers musiques (22,050 et 44,1)
Avoir Dossier destination-> Dossier artistes-> Fichier musiques (44,1)
Ou si cela est plus simple, supprimer tous les fichiers en 22,050 du
dossier source.
Je vous remercie d'avance.
Jacques
Salut a toutes et tous
Voila j'ai des fichiers de musiques, qui on été encodé a 22,050 au lieu de
44,1.
Et il possible par VBA en séléctionnant le dossier source de faire une
recherche de tous les fichier en 44,1 et de les envoyer dans un un dossier
déstination en gardant la structure du dossier source.
Si :
Dossier source->Dossier artistes-> Fichiers musiques (22,050 et 44,1)
Avoir Dossier destination-> Dossier artistes-> Fichier musiques (44,1)
Ou si cela est plus simple, supprimer tous les fichiers en 22,050 du
dossier source.
Je vous remercie d'avance.
Jacques
