Re: Extraire la durée des fichiers audio ou vidéo :WMV , AVI , WAV , MP3
bonsoir Didier
j'espere que ces exemples pourront t'aider
j'ai aussi inséré une macro pour les fichiers MPEG , bien que chez moi cela renvoie des valeurs incohérentes …à tester ...
necessite d'activer reference Microsoft Shell Controls and Automation pour les fichiers WMV et AVI
Option Explicit
''*********************** durée fichiers WAV , MPEG , MP3 ****************************
Declare Function mciSendString Lib "winmm.dll" Alias _
"mciSendStringA" (ByVal lpstrCommand As String, ByVal _
lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal _
hwndCallback As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" _
Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Sub dureeFichierWAV()
Dim s As String * 255
Dim i As Long
Dim ShortName As String
''ouvrir la session
ShortName = GetShortName("C:\Documents and Settings\michel\dossier\fichierSon.wav")
i = mciSendString("open " & ShortName & " type waveaudio alias Voix1", 0&, 0, 0)
''reuperer les infos
i = mciSendString("status voix1 length", s, Len(s), 0)
MsgBox Val(s) & " millisecondes"
''fermer la session
i = mciSendString("close voix1", 0&, 0, 0)
End Sub
Sub dureeFichierMP3()
Dim s As String * 255
Dim i As Long
Dim ShortName As String
''ouvrir la session
ShortName = GetShortName("C:\Program Files\Variations on a Ditty.mp3")
i = mciSendString("open " & ShortName & " type MPEGVideo alias Voix1", 0&, 0, 0)
''reuperer les infos
i = mciSendString("status voix1 length", s, 255, 0)
MsgBox Val(s) & " millisecondes"
''fermer la session
i = mciSendString("close voix1", 0&, 0, 0)
End Sub
Sub dureeFichierMPG()
''à tester ( renvoie des valeurs incohérentes chez moi )
Dim s As String * 255
Dim i As Long
Dim ShortName As String
''ouvrir la session
ShortName = GetShortName("C:\Documents and Settings\michel\maVideo.mpg")
i = mciSendString("open " & ShortName & " type MPEGVideo alias Vid01", 0&, 0, 0)
''reuperer les infos
i = mciSendString("status Vid01 length", s, Len(s), 0)
MsgBox Val(s) & " millisecondes"
''fermer la session
i = mciSendString("close Vid01", 0&, 0, 0)
End Sub
Public Function GetShortName(ByVal sLongFileName As String) As String
Dim lRetVal As Long, sShortPathName As String, iLen As Integer
sShortPathName = Space(255)
iLen = Len(sShortPathName)
lRetVal = GetShortPathName(sLongFileName, sShortPathName, iLen)
GetShortName = Left(sShortPathName, lRetVal)
End Function
''***********************************************************************
'********* durée fichiers WMV , AVI *************************************
Sub PropriétésFichiersWMV()
''http://www.microsoft.com/resources/documentation/windows/2000/server/scriptguide/en-us/sas_fil_lunl.mspx
'necessite d'activer reference Microsoft Shell Controls and Automation
Dim objShell As Object, strFileName As Object
Dim objFolder As Folder
Dim Resultat As String
Dim i As Byte
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace("C:\Documents and Settings\michel") 'adapter le chemin
''boucle sur tous les fichiers "wmv" du répertoire
For Each strFileName In objFolder.Items
If Right(objFolder.GetDetailsOf(strFileName, 0), 4) = ".wmv" Then _
MsgBox objFolder.GetDetailsOf(strFileName, 0) & vbLf & objFolder.GetDetailsOf(strFileName, 21)
Next
End Sub
Sub PropriétésFichiersAVI()
''http://www.microsoft.com/resources/documentation/windows/2000/server/scriptguide/en-us/sas_fil_lunl.mspx
''necessite d'activer reference Microsoft Shell Controls and Automation
Dim objShell As Object, strFileName As Object
Dim objFolder As Folder
Dim Resultat As String
Dim i As Byte
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace("C:\Documents and Settings\michel") 'adapter le chemin
''boucle sur les fichiers "avi" du répertoire
For Each strFileName In objFolder.Items
''attention à l'écriture de ".avi" : sensible aux majuscules et minuscules
If Right(objFolder.GetDetailsOf(strFileName, 0), 4) = ".avi" Then _
MsgBox objFolder.GetDetailsOf(strFileName, 0) & vbLf & objFolder.GetDetailsOf(strFileName, 21)
Next
End Sub
''*************************************************************************
bonne soirée
MichelXld
