Liste excel à partir de répertoire windows

Version imprimable

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:

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

15/12/2017, 10h45
kiki29
Salut, à toi de voir :
Après pour lister les propriétés tu as : Liste des propriétés de fichiers
15/12/2017, 11h29
tiouam

merci pour ta réponse rapide je vais regarder les liens
et désolé pour la mauvaise place de la discution
16/12/2017, 16h42
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 ) ?
17/12/2017, 22h42
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é
18/12/2017, 03h33
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.

1 pièce(s) jointe(s)

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
Pièce jointe 335660

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:

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:

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

19/12/2017, 02h07
kiki29

2 pièce(s) jointe(s)

Salut, @tiouam : un 1er jet
01/01/2018, 03h36
kiki29

Salut, voir ici