Discussion :

[tiouam]

Bonjour,

nouveau sur le forum, mon but et de créer une macro pour lister les vidéo sur mon pc

j'ai trouvé cette macro qui fonctionne très bien :
http://www.vbaexpress.com/kb/getarticle.php?kb_id=405

cependant il me liste tous les types de fichier
j'ai du créer une macro de nettoyage pour supprimer les éléments non désirés :

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
Sub retirer_le_surplut()
'
' retirer_le_surplut Macro
'
' Touche de raccourci du clavier: Ctrl+k
'
    Range("F1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$K$983294").AutoFilter Field:=6, Criteria1:=Array( _
        "Archive WinRAR", "Chrome HTML Document", "Data Base File", "Fichier IDX", _
        "Fichier JPG", "Fichier PNG", "Fichier SUB", "Paramètres de configuration"), _
        Operator:=xlFilterValues
    Range("A151").Select
    ActiveWindow.SmallScroll Down:=-144
    Rows("2:252").Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$1:$K$983130").AutoFilter Field:=6, Criteria1:=Array( _
        "VLC media file (.avi)", "VLC media file (.mkv)", "VLC media file (.mp4)"), _
        Operator:=xlFilterValues
    ActiveWindow.SmallScroll Down:=-132
End Sub

comment je peux faire pour l'intégrer au code principal?

j'aimerais conserver un lien hypertext pour que l'excel se mette à jour si je modifie un nom de fichier ou une extension de fichier ; et-ce que c'est possible?

merci d'avance pour votre aide

[kiki29]

Salut, à toi de voir :

• Liste des fichiers d'un dossier : Win 32/64 Bits
• Liste des fichiers d'un dossier + Liens
• liste des fichiers avec visualisation de l'arborescence
• Liste des fichiers d'un dossier avec recherche récursive ou non via les APIs

Après pour lister les propriétés tu as : Liste des propriétés de fichiers

[tiouam]

merci pour ta réponse rapide je vais regarder les liens
et désolé pour la mauvaise place de la discution

[kiki29]

Re, une approche qui pourrait t'intéresser serait d'utiliser une appli combinant le 1er lien pour lister les fichiers ( la plus rapide et de loin de toutes : dir, fso ) et le dernier pour récupérer qqs infos sur ces fichiers via fso en 2 passes se suivant ( plus rapide qu'un mixte ) ?

[tiouam]

Bonsoir merci pour ton aide
mais visiblement je m'y connais pas assez pour comprendre et arranger les codes à ma convenance ... je vais abandonner l'idée je penses et faire à la main ...
l'idée me plaisait bien mais déjà je n'arrive pas à modifier les propriété des fichiers en mkv alors que les films en mp4 ça fonctionne
mais en mp4 j'ai les sous titre à part

donc en fait tant que je n'arriverai pas à modifier les propriétés des vidéos en .mkv, ce que je veux faire comme extraire les noms de vidéos, mettre un lien hypertext, largeur et hauteur de trame, prducteur, genre et année par exemple bah ça va être compliqué

[kiki29]

Salut, tu parlais au départ de lire et maintenant de modifier ce n'est absolument pas la même chose, voir Lire et modifier les propriétés des classeurs et autres fichiers avec DSO, mais cela de façon très limitée.

[patricktoulon]

salut kiki

tu devrait mettre une gestion d'erreur dans ton listeur de fichier quand on selectionne recursive et que l'on prend un disque pour racine


sinon il y a dir dans une fonction recursive qui te liste plus de 800 video dans divers dossier et sous dossiers quasiment instantanément (moins d' une demie seconde)
avec la variable crit on peut choisir d'occulter ou garder des dossier cachés system et autre j'exepte aussi les dossier de la poubelle "recycle"
exemple

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
Function liste_mes_Fichiers(path As String, Optional T As Variant = Null, Optional ExT As Variant = 0, Optional a As Long = 0)
    Dim itemVU As String, folder As Variant, dirCollection As Collection, i As Long
    Set dirCollection = New Collection
    If IsNull(T) Then T = Array()
    crit = vbDirectory Or vbHidden Or vbNormal Or vbArchive Or vbReadOnly Or vbSystem Or vbVolume
    On Error GoTo passe
    itemVU = Dir(path, crit)
    'Debug.Print IsArray(ExT)
    'Explore le dossier courant (path)
    Do Until itemVU = vbNullString
        'si ce n'est pas un dossier on ajoute le fichier a la liste
        If Left(itemVU, 1) <> "." And Not path Like "*RECYCLE*" Then
            If (GetAttr(path & itemVU) And vbDirectory) <> vbDirectory Then
                'Debug.Print Right(itemVU, 4)
                If IsArray(ExT) Then
                    For i = 0 To UBound(ExT)
                        If itemVU Like "*" & ExT(i) Then
                            ReDim Preserve T(0 To a): T(a) = path & itemVU: a = a + 1:
                        End If
                    Next
                Else
                    ReDim Preserve T(0 To a): T(a) = path & itemVU: a = a + 1:
                End If
            End If
        End If
        'ajout des dossiers enfant direct de la racine a la collection
        If Left(itemVU, 1) <> "." And (GetAttr(path & itemVU) And vbDirectory) = vbDirectory Then
            dirCollection.Add itemVU
        End If
        itemVU = Dir()
    Loop
passe:
Err.Clear
    'Exploration des sudossier inscrit dans la collection
    For Each folder In dirCollection
        'Debug.Print "---SubDirectory: " & directory & "---"
        liste_mes_Fichiers path & folder & "\", T, ExT, a
    Next folder
    liste_mes_Fichiers = T
End Function

exemple de sud de test ici on prend tout un disque

Code :

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

1
2
3
4
5
Sub Test()
'tabl = liste_mes_Fichiers("H:\") ' TOUT FICHIERS
    tabl = liste_mes_Fichiers("d:\", ExT:=Array(".mp4", ".avi", ".ts", ".flv"))  ' EXTENTION DEMANDE
    Cells(1, 1).Resize(UBound(tabl), 1) = Application.Transpose(tabl)
End Sub

[kiki29]

Salut, @tiouam : un 1er jet

[kiki29]

Salut, voir ici