[VBA-E]parcourir partour dans mon ordi pour trouver des avi

bonjour,
j'Aimerais faire une liste de tout les videos que j'ai sur mon ordi (mpeg, avi.....).Étant paresseuse, je me suis dit que ça irait surement plus vite si je me faisait un petit programme recherchant ça a ma place. seulement, je n'ai qu'excel comme outil pour pouvoir coder..
je me suis dit que je coderais une macro qui écrirait tous les nom des fichiers ayant comme extension tout les fichier video.
je crois bien que excel marche avec vb....j'aimerais donc avoir des petits indice a savoir, comment faire pour faire une recherche partout
merci
shirya

tiens je me suis inspirer du code :

http://support.microsoft.com/default...%3Bfr%3B467457

pour créer cette macro :

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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
 
Option Explicit
 
Public Const MAX_PATH = 260
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const ERROR_NO_MORE_FILES = 18&
 
'Struture utilisée par WIN32_FIND_DATA
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
 
'Struture utilisée par FindFirstFile
Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
 
Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
(ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
(ByVal hFindFile As Long, lpFindFileData As _
WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long
Declare Function GetLastError Lib "kernel32" () As Long
'Détermine la longeur d'une chaine passée en argument.
Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" _
(ByVal lpString As String) As Long
 
Sub Fnc_Recherche_Video(Rep As String)
Dim WFD As WIN32_FIND_DATA
Dim Handle_Recherche As Long
Dim Suite_Recherche As Long
Dim FileName As String
Dim nb_car As String
Dim Rep_Recherche As String
 
 
Rep_Recherche = Rep & "*.*" 'Contient le répertoire de recherche
'Initialisation de la recherche avec le chemin du répertoire à scruter.
Handle_Recherche = FindFirstFile(Rep_Recherche, WFD)
If Handle_Recherche = INVALID_HANDLE_VALUE Then
'Cela signifie que la recherche ne peut se faire
MsgBox ("Erreur dans le chemin de recherche")
Exit Sub
End If
 
Suite_Recherche = 1
Do While Suite_Recherche <> 0
DoEvents
'Retourne le nb de caractères précédent celui de fin de chaîne.
nb_car = lstrlen(WFD.cFileName)
'Extrait les caractères valides
FileName = LCase(Left(WFD.cFileName, nb_car))
'Teste si c'est un répertoire
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
'Vérifie si le nom du répertoire n'est pas le mère ou
'l'enfant. (.. ou .)
If (FileName <> "." And FileName <> "..") Then
'Ajoute le répertoire à la liste de ceux scrutés.
'ListDirectory.AddItem (Rep & FileName & "\")
'Appel récursif pour recherche dans le nouveau
'répertoire trouvé.
Application.StatusBar = "Traite rep : " & Rep
Call Fnc_Recherche_Video(Rep & FileName & "\")
End If
End If
If FileName Like "*.avi" Or _
   FileName Like "*.mpg" Then
'ListFile.AddItem (Rep & FileName)
'Rajoute nom de fichier dans feuille excel courante cellule courante ( puis passe cellule en dessous)
 ActiveCell = Rep & FileName
 ActiveCell.Offset(1, 0).Activate
 Debug.Print "--------------------- > " & Rep & FileName
 
 
End If
'Recherche le fichier suivant.
'Si Suite_Recherche vaut 0 le répertoire est vide et l'on
'quitte la fonction.
Suite_Recherche = FindNextFile(Handle_Recherche, WFD)
Loop
FindClose (Handle_Recherche)
Application.StatusBar = False
End Sub
'
'  Positionner le curseur sur la premiére cellule (en haut) devant acceuillir les noms de fichiers
'
Sub Test()
Fnc_Recherche_Video "c:\"
End Sub

Maintenant, si c'est simplement en avoir la liste, tu peux faire ça :

Code:

Call Shell("cmd /c dir c:\*.avi /o /s > c:\ListeAvi.txt")

/o les mets par ordre alpha, et /s visite tous les sous-répertoires

Sous word, tu supprimes un saut de ligne sur deux, c'est plus lisible...

A+

Citation:

Envoyé par ouskel'n'or

Maintenant, si c'est simplement en avoir la liste, tu peux faire ça :

Code:

Call Shell("cmd /c dir c:\*.avi /o /s > c:\ListeAvi.txt")

/o les mets par ordre alpha, et /s visite tous les sous-répertoires

Sous word, tu supprimes un saut de ligne sur deux, c'est plus lisible...

A+

et les *.mpg....

Citation:

Envoyé par bbil

et les *.mpg

ca devrais donner ca :

Code:

Call Shell("cmd /c dir c:\*.mpg /o /s > c:\ListeMpg.txt")

MARCI !ça marche :D
désolée pour le délai....