Un premier script génère une bibliothèque des fichiers MP3 présent dans un dossier. Un second permet de sélectionner aléatoirement des fichiers de la bibliothèque et les copies sur un support amovible de type clé USB MP3. Le script vérifie, si le fichier n'à pas déjà été copié grâce à un fichier d'historique qui stock tous les fichiers envoyés sur le support de destination. Le nombre de fichier copié varie en fonction de la taille disponible sur le support de destination.
Il est possible de modifier ce script comme bon vous semble pour l'adapter à vos besoins.
Source / Exemple :
'##########################################################
'# Script crée par Splite #
'# splite@ifrance.com #
'##########################################################
Option Explicit
Dim ptObj, ptDossier, Tab1, Tab2, Tab3, Fichier, Dossier, TabMaMusique(),ptDossierMusique
Dim ContenueF, txtF, i, CheminLib, CheminMusique, DossierNomLib,Musique,ptDossierMus, MaMusique,MaLibrairie
'Dossier contenant les fichiers de musique à scanner
MaMusique = "C:\Data\Ma Musique\"
'Dossier où la librairie doit être crée
MaLibrairie = "C:\Data\Ma Musique\Librairie\"
Set ptObj = CreateObject("Scripting.FileSystemObject")
Set ptDossierMusique = ptObj.GetFolder(MaMusique)
Set Musique = ptDossierMusique.SubFolders
i = 1
'On boucle on fonction du nombre de fichier trouvé dans le chemin "MaMusique"
For Each DossierNomLib in Musique
If DossierNomLib.name <> "Librairie" Then
CheminLib = MaLibrairie & "Librairie_" & DossierNomLib.name &".txt"
CheminMusique = MaMusique & DossierNomLib.name
'Création et ouverture d'un fichier librairie suivant le genre trouvé dans le chemin "MaMusique"
Set txtF = ptObj.OpenTextFile(CheminLib,2,1)
'J'obtient un objet qui me permettra de scanné les dossiers et fichiers du dossier actuelle
Set ptDossierMus = ptObj.GetFolder(CheminMusique)
Set Fichier = ptDossierMus.Files
Set Dossier = ptDossierMus.SubFolders
'Appel de la fonction récursive de scan des dossiers
SauveFichier()
End If
Next
MsgBox "La bibliothèque à correctement été crée, " & i & " fichiers trouvés",64,"Bibliothèque crée"
'Fermeture du fichier
txtF.Close
'Destruction de l'object
Set ptObj = Nothing
'Définition de la fonction récursive
Function SauveFichier()
For Each Tab2 in Dossier
Set ptDossier = ptObj.GetFolder(Tab2)
Set Dossier = ptDossier.SubFolders
Set Fichier = ptDossier.Files
For Each Tab1 in Fichier
If Right(Tab1.name,3) = "mp3" Then
ContenueF = ptDossier.Path & "\" & Tab1.name
txtF.WriteLine ContenueF
i = i+1
End If
Next
If Dossier.count <> 0 Then
For Each Tab3 in Dossier
SauveFichier()
Next
End If
Next
End Function
'##########################################################
'# Script crée par Splite #
'# splite@ifrance.com #
'##########################################################
Option Explicit
Dim nbAlea, Fichier, Stream, FichSauve, CheminLib, CheminSauve, Drive,TailleFree, remplire,TabFich
Dim Free, FichierSelect, Taille, NbLigne, ptObj, Tab(), NbLigneHist, Exist,lettreSupport,FichLib
Dim jour, mois, annee, Date, i, TabHist(), Selection, TailleMax, CheminDest, nbFichCopie,NomFichLib
Dim MaMusique, j, message, ListeDossier,StreamHist,FichierHist,x
'##########################################################
'# Informations à modifier avant éxecution du script #
'##########################################################
'Chemin du fichier d'historique des fichiers copiés
CheminSauve = "C:\Data\Ma musique\Librairie\Historique.txt"
'Dossier contenant les fichiers de musique à scanner
MaMusique = "C:\Data\Ma Musique\"
'Chemin du support de destination
CheminDest = "C:\Data\dest\"
'Chemin du dossier contenant les librairies
CheminLib = "C:\Data\Ma Musique\Librairie\"
'Taille maximum des fichiers à copier
TailleMax = 5
'Mettez 1 pour remplir completement le support de destination et 0 dans le cas contraire
remplire = 0
'Si vous venez de mettre 0, choisissez la taille max en Mo
TailleFree = 50
'##########################################################
'# Fin des modifications #
'##########################################################
Sub Copie
Jour = WeekdayName(Weekday(Day(Now)))
Mois = MonthName(Month(Now))
Annee = Year(Now)
Date = jour&" "&Day(Now)&" "&mois&" "&annee
Set ptObj = CreateObject("Scripting.FileSystemObject")
Set FichLib = ptObj.GetFolder(MaMusique)
Set NomFichLib = FichLib.SubFolders
ReDim ListeDossier(NomFichLib.count)
message = "Quels genre de musique voulez-vous copier" & VbCrLf & VbCrLf
j = 1
For Each TabFich in NomFichLib
If TabFich.name <> "Librairie" Then
message = message & j & " " & TabFich.Name & VbCrLf
ListeDossier(j) = TabFich.Name
j = j + 1
End If
Next
Selection = InputBox(message,"Fichiers à copier","1")
'Si on Annulation, on quitte le programme
If Selection = "" Then
Exit Sub
End If
CheminLib = "C:\Data\Ma musique\Librairie\Librairie_" & ListeDossier(Selection) & ".txt"
Taille = 0
Randomize
'Ouverture en lecture de la librairie
Set Fichier = ptObj.GetFile(CheminLib)
Set Stream = Fichier.OpenAsTextStream(1)
'Ouverture en lecture du fichier Historique.txt
Set StreamHist = ptObj.OpenTextFile(CheminSauve,1,True)
'Connexion sur le support amovible
Set Drive = ptObj.Drives("C")
If ptObj.FolderExists(CheminDest) = False Then
'Création du dossier "Ma Musique" sur le support
ptObj.CreateFolder(CheminDest)
End If
'Calcul du nombre de lignes présent dans lib.txt
NbLigne = 0
Do While Stream.AtEndOfStream <> True
NbLigne = NbLigne + 1
Stream.SkipLine
Loop
'Calcul du nombre de lignes présent dans Historique.txt
NbLigneHist = 0
Do While StreamHist.AtEndOfStream <> True
NbLigneHist = NbLigneHist + 1
StreamHist.SkipLine
Loop
StreamHist.Close
Set FichierHist = ptObj.GetFile(CheminSauve)
Set StreamHist = FichierHist.OpenAsTextStream(1)
'Dimensionnement du tableau du fichier d'historique
ReDim TabHist(NbLigneHist)
NbLigneHist = NbLigneHist - 1
'Je stock le contenue du fichier Historique.txt dans un tableau
For i = 0 To NbLigneHist
TabHist(i)= StreamHist.ReadLine
Next
'Fermeture du fichier lib.txt afin que le pointeur de ligne remonte en haut du fichier
Stream.Close
'Ouverture en lecture du lib.txt
Set Stream = Fichier.OpenAsTextStream(1)
'Ouverture en écriture du Historique.txt
Set FichSauve = ptObj.OpenTextFile(CheminSauve,8,1)
'J'insère la date du jour dans le fichier d'historique
FichSauve.WriteLine Date
FichSauve.WriteBlankLines(1)
If remplire = 1 Then
'Calcul l'espace restant sur le support
Free = Drive.FreeSpace * 0.000001
Free = Round(Free, 0)
Else
Free = TailleFree
End If
'Si l'espace est inférieur à 5 Mo on stope le processus
If Free < 5 Then
MsgBox "Pas assez d'espace libre sur le support",16,"Manque d'espace disque"
Else
NbLigne = NbLigne - 1
ReDim Tab(NbLigne)
'Je stock le contenue du fichier lib.txt dans un tableau
For i = 0 To NbLigne
Tab(i)= Stream.ReadLine
Next
nbFichCopie = 0
Do While Taille < Free
'Génération d'un nombre aléatoire
nbAlea = Int((NbLigne - 0 + 1) * Rnd + 0)
'J'accède aux propriétés du fichier
Set FichierSelect = ptObj.GetFile(Tab(nbAlea))
'Je vérifie que le fichié a copier ne la pas été déjà, grace au fichier d'historique
Exist = 0
For x=0 To NbLigneHist
'Comparaison du fichier dans l'historique et celui à copier
If StrComp(FichierSelect.Path,TabHist(x),vbTextCompare) = 0 Then
Exist = 1
End If
Next
If Exist = 0 Then
'Si le fichier dépasse 5 Mo on le jette
If (FichierSelect.Size * 0.000001) <= TailleMax Then
'Je stock dans le fichier d'historique les fichiers copié sur le support
FichSauve.WriteLine Tab(nbAlea)
'Additionne la taille des fichiers
Taille = Taille + Round(FichierSelect.Size * 0.000001)
'Copie du fichier selectionné aléatoirement sur le support
ptObj.CopyFile Tab(nbAlea), CheminDest
End If
End If
'Information sur le nombre total de fichier copié
nbFichCopie = nbFichCopie + 1
Loop
MsgBox "Copie des fichiers terminée "& nbFichCopie &" fichiers copiés, soit : "& Taille &" Mo",64,"Copie terminée"
End If
FichSauve.WriteBlankLines(2)
'Fermeture des fichiers
Stream.Close
StreamHist.Close
FichSauve.Close
End Sub
'On appel la fonction de copie aléatoire
Copie
Conclusion :
Etant donné que c'est mon premier script en VBS, il se peut que vous trouviez quelques bugs, malgré les soins que j'y est apporté...je vous laisse les découvrir
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.