COPIE ALÉATOIRE DE MUSIQUE POUR CLÉ USB MP3

'##########################################################
'#              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