Extraire dans EXCEL la durée d'un fichier audio ou vidéo

D

didier

Guest
Bonjour

Peux t'on extraire dans EXCEL la durée d'un fichier AUDIO ou VIDEO.

Merci
 
M

michel

Guest
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
 
D

didier

Guest
Michel

Merci bcp pour ta réponse mais ou peut on activer reference Microsoft Shell Controls and Automation.

Il y a un pavé automation dans les macro complémentaires mais je n'ai pas trouvé shell controls

A+ et bonne année 2005

Didier
 

Discussions similaires