'Version du 11 aout 2014 'Ajout de la commande pour aller dans le lecteur qui contient les vidéos à convertir 'Ajout de la suppression du premier fichier avi Option Explicit Dim CheminScriptActuel, ScriptFileName, Position, CheminFichierResultat, CheminRepertoireAExplorer Dim objFSO, objFolder, objTextFile, MyFile, ExtensionFichier, NomFichierSansExtension 'Déclaration des constantes pour la lecture et l'ecriture dans les fichiers Const ForReading = 1 Const ForWritting = 2 Const ForAppending = 8 CheminScriptActuel = Left(wscript.scriptfullname,Len(wscript.scriptfullname)-Len(wscript.scriptname)-1) ScriptFileName = wscript.scriptname Position = InstrRev(ScriptFileName,".") if (Position > 0) Then ScriptFileName = Left(ScriptFileName, Position - 1) CheminFichierResultat = CheminScriptActuel & "\" & ScriptFileName & "_Fichier_Batch_Resultant.bat" CheminRepertoireAExplorer = InputBox("Entrez le chemin du répertoire","Chemin du répertoire",CheminScriptActuel) CheminFichierResultat = InputBox("Entrez le chemin du fichier contenant le resultat","Chemin du fichier de reponse",CheminFichierResultat) 'Création des objets Set objFSO = CreateObject("Scripting.FileSystemObject") 'On fait un objet qui représente le répertoire à explorer Set objFolder = objFSO.GetFolder(CheminRepertoireAExplorer) Set objTextFile = objFSO.OpenTextFile(CheminFichierResultat, ForWritting, True) If Left(CheminScriptActuel, 2) = "\\" Then Wscript.echo "Attention : Les chemmins réseau ne sont pas traité correctement." Else objTextFile.WriteLine(Left(CheminScriptActuel, 1) & ":") End If objTextFile.WriteLine("Cd """ & CheminScriptActuel & """") For Each MyFile In objFolder.Files ExtensionFichier = "" Position = InStrRev(MyFile.Name,".") If (Position > 0) And (Position < Len(MyFile.Name)) Then ExtensionFichier = Mid(MyFile.Name,Position+1) NomFichierSansExtension = Left(MyFile.Name,Position-1) If (Lcase(ExtensionFichier) = "mov") Or (Lcase(ExtensionFichier) = "avi") Then objTextFile.WriteLine("ffmpeg_2013_08_24.exe -i """ & MyFile.Name & """ -b:a 256K -vcodec mpeg4 -b:v 12000K """ & NomFichierSansExtension & ".mp4""") 'objTextFile.WriteLine("ffmpeg_2013_08_24.exe -i """ & MyFile.Name & """ -b:a 256kb -vcodec mpeg4 -b:v 12000kb -pass 1 -passlogfile SecondPass """ & NomFichierSansExtension & "firstpass.mp4""") 'objTextFile.WriteLine("ffmpeg_2013_08_24.exe -i """ & MyFile.Name & """ -b:a 256kb -vcodec mpeg4 -b:v 12000kb -pass 2 -passlogfile SecondPass """ & NomFichierSansExtension & ".mp4""") 'objTextFile.WriteLine("Del /F """ & NomFichierSansExtension & "firstpass.mp4""") End If End If Next objTextFile.Close Set objTextFile = Nothing Set objFolder = Nothing Set objFSO = Nothing Public Function LancerExecutableWScriptShellRun(ByVal CheminExecutable, ByVal Arguments, ByVal ModeExecution, ByVal AttendreExecutable) 'Version du 30 septembre 2009 : Retour d un eventuel message d erreur 'Ex Version du 04 avril 2008 'Ex Version du 26 mars 2008 'Ex Version du 5 mars 2008 'LancerExecutableWScriptShellRun ne retourne rien si il n y a pas eu de probleme, sinon retourne un message d erreur 'Valeurs de ModeExecution : ' 0 : Cache et active une autre fenetre ' 1 : active la fenêtre de l executable et l affiche normalement ' 2 : active et minimise la fenetre ' 3 : active et maximise la fenetre ' 4 : ne touche pas a la fenetre active, affiche a la taille la plus recente ' 5 : active la fenetre active, affiche a la taille la plus recente ' 6 : ' 7 : ne touche pas a la fenetre active, minimise la fenetre ' 8 ' 9 ' 10 'Valeurs de AttendreExecutable ' True ' False Dim Commande Dim ObjShell Dim NumeroErreur Dim VariableBidon LancerExecutableWScriptShellRun = "" 'Valeur par defaut Select Case Cstr(ModeExecution) Case "1", "2", "3", "4", "5", "6", "7", "8", "9", "10" VariableBidon = 2 Case Else ModeExecution = 1 End Select Select Case AttendreExecutable Case True VariableBidon = 2 Case False VariableBidon = 2 Case Else AttendreExecutable = True End Select Commande = CheminExecutable If Len(Arguments) > 0 Then Commande = Commande & " """ & Arguments & """" 'Commande = """" & Commande & " """ & Arguments & """" & """" 'MsgBox Commande End If 'Creation de l'objet Shell Err.Clear On Error Resume Next Set ObjShell = WScript.CreateObject("WScript.Shell") NumeroErreur = Err.number On Error Goto 0 If NumeroErreur = 0 Then 'object.Run(strCommand, [intWindowStyle], [bWaitOnReturn]) '1 pour activer la fenêtre et l'afficher normalement 'Commande = "%windir%\notepad.exe" 'Préparation de la ligne de commande a éxecuter Err.Clear On Error Resume Next ObjShell.Run Commande, ModeExecution, AttendreExecutable NumeroErreur = Err.number On Error Goto 0 If NumeroErreur = 0 Then LancerExecutableWScriptShellRun = "" End If 'Destruction de l'objet Shell Set ObjShell = Nothing Else LancerExecutableWScriptShellRun = "Impossible de lancer la commande """ & Commande & """ car l appel de la fonction WScript.Shell ne fonctionne pas" End If 'If NumeroErreur = 0 Then End Function