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

Bonjour

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

Merci

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

rebonsoir

une petite précision :

pour les CD audios ".CDA" , tu peux tester le lien ci desssous

http://www.excel-downloads.com/html/...23722&t=123722


bonne soiree
MichelXld

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

Michel

A priori durée fichier mp3 marche aussi pour les .avi et .wmv

Encore merci pour ta réponse

A+

Didier

bonjour Didier

pour activer une référence :

tu vas dans Visual Basic Editor ( Alt+F11 )
Menu Outils
References
coches la ligne "Microsoft Shell Controls and Automation"
cliques sur OK pour valider


bon apres midi
MichelXld

Michel

Merci beaucoup

Didier