Discussion :

[eliot.raymond]

Bonjour.

J'ai trouvé ce code qui liste les fichiers d'un répertoire sur le site il fonctionne bien. Merci au passage à l'auteur.

Malgré mes recherches je n'ai pas trouvé comment ajouter le code qui

permet d'obtenir la durée (par exemple d'une vidéo),(.avi) ou autre

Si vous savez alors merci à vous, je suis preneur de toute solution.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Option Explicit
 
Sub TestListeFichiers()
    Dim Dossier As String
 
    'Définit le répertoire pour débuter la recherche de fichiers.
    '(Attention à ne pas indiquer un répertoire qui contient trop de sous-dossiers ou de
    'fichiers, sinon le temps de traitement va être très long).
    Dossier = "C:\Documents and Settings\mimi\dossier"
 
    'Appelle la procédure de recherche des fichiers
    ListeFichiers Dossier
 
    'Ajuste la largeur des colonnes A:E en fonction du contenu des cellules.
    Columns("A:E").AutoFit
    MsgBox "Terminé"
End Sub
 
Sub ListeFichiers(Repertoire As String)
    '
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
        'Dans l'éditeur de macros (Alt+F11):
        'Menu Outils
        'Références
        'Cochez la ligne "Microsoft Scripting RunTime".
        'Cliquez sur le bouton OK pour valider.
 
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim i As Long
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
 
    'Récupère le numéro de la dernière ligne vide dans la colonne A.
    i = Range("A65536").End(xlUp).Row + 1
 
    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
        'Inscrit le nom du fichier dans la cellule
        Cells(i, 1) = FileItem.Name
        'Ajoute un lien hypertexte vers le fichier
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
            Address:=FileItem.ParentFolder & "\" & FileItem.Name
        'Indique la date de création
        Cells(i, 2) = FileItem.DateCreated
        'Indique la date de dernier acces
        Cells(i, 3) = FileItem.DateLastAccessed
        'Indique la date de dernière modification
        Cells(i, 4) = FileItem.DateLastModified
        'Nom du répertoire
        Cells(i, 5) = FileItem.ParentFolder
 
        i = i + 1
    Next FileItem
 
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder
 
End Sub

Bon après-midi à tous.

Raymond

[patricktoulon]

Tu pourrais peut être faire appel aux apis du wmplayer

Dans la faq tu as ça
Cherche bien
Dans les sources il y a même un player

Au plaisir

[eliot.raymond]

Bonsoir tous le monde, forum

Bonsoir Patricktoulon

Merci pour ta réponse, c'est sympa, tu vois ca fait 3 jours que je suis dessus, j'ai trouver sur le net les deux codes ci-dessous, mais je n'arrive pas a incorporer le chainon manquant au code d'origine afin d'obtenir le résultat souhaiter.
et je ne suis pas très fort du tout en vba

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
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("E:\videos") '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
'-----------------------
 
Dim arrHeaders(35)
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace("E:\Videos")
For i = 0 To 34
 arrHeaders(i) = objFolder.GetDetailsOf(objFolder.Items, i)
Next
For Each strFileName In objFolder.Items
 For i = 0 To 34
 Wscript.Echo i & vbTab & arrHeaders(i) _
 & ": " & objFolder.GetDetailsOf(strFileName, i)
 Next
Next

Un petit coup de main serai bienvenu, merci

au plaisir de relire et bonne soirée a tous

Merci patrick

Raymond

[patricktoulon]

je vais examiner ca en detail

deja a premiere vu il manque des variable declarée en debut de sub

mais je vais voir ca



au plaisir

[eliot.raymond]

Bonsoir a tous

Bonsoir Patrick

je te remercie pour ton coup de main j'apprécie car je ne pensait pas que c'était dur d'afficher la durée d'une video, la moi je nage comme une clé a molette,hihihi

bonne soirée a toi bon app et merci

Raymond

[patricktoulon]

bonjour raymond

tien regarde ce petit bricolage
j'oubliais ca marche pour tout les fichier media que le windowmediaplayer est cappable de lire
au plaisir