Alternative a FSO
Bonjour je souhaiterais savoir si il existe une alternative a FSO car c'est actuellement la procedure que j'utilise mais le soucis est qu'il met environ 40Minute pour me sortir la liste de fichier que je veut j'ai bien essaye avec Dir mais je me noie :/
Private Sub Command1_Click()
Application.ScreenUpdating = False
Columns(1).ClearContents
Cells(1, 1) = Timer
Dim fso As FileSystemObject, dossier As Folder, sousdossier As Folder, fichier As File
Set fso = New FileSystemObject
Set dossier = fso.GetFolder("Y:\")
scan dossier
Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = Timer - Cells(1, 1)
Application.ScreenUpdating = True
End Sub
Public Sub scan(ByVal dossier As Folder)
For Each fichier In dossier.Files
If InStr(fichier, "SLDDRW") <> 0 Then
'Debug.Print fichier
Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = fichier
End If
Next
For Each sousdossier In dossier.SubFolders
'Debug.Print sousdossier
scan sousdossier
Next
End Sub
Bonjour mallarddam,
j'ai fait le test sans la condition "SLDDRW" résultat: 1256 fichiers en 1 min 22 sec
Sub Fichiers()
'Application.ScreenUpdating = False
Dim myPath As String, myFile As String
myPath = ThisWorkbook.Path
myFile = Dir(myPath & "\*.xls*")
c = 1
Do While myFile <> ""
If InStr(fichier, "SLDDRW") <> 0 Then Cells(c, 1) = myFile
myFile = Dir()
c = c + 1
Loop
End Sub
sabV Merci de ta réponse mais sauf erreur de ma part le code ne liste pas les sous dossier ?
EDIT j'ai essayé ce code la mais j'ai l'erreur suivante sur la ligne
myFolder = Dir()
Erreur d'exécution '5':
Argument ou appel de procédure incorect
Sub Liste(ByVal mypath As String)
Dim myFolder As String
myFolder = Dir(mypath & "*", vbDirectory)
Do While myFolder <> ""
If (GetAttr(mypath & myFolder) And vbDirectory) = vbDirectory And Right(myFolder, 1) <> "." Then
Liste (mypath & myFolder & "\")
ElseIf Right(myFolder, 1) <> "." Then
Debug.Print "Fichier: " & myFolder
End If
myFolder = Dir()
Loop
End Sub
Sub Test12()
Liste ("C:\test\")
End Sub
- Messages
- 4'097
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Bonjour,
Je ne suis pas sûr que le temps de réponse soit lié au modèle FSO car a priori balayer 20.000 fichiers ne devrait lui prendre que quelques minutes. L'unité Y ne serait-elle pas un lecteur réseau ? Il pourrait y avoir des lenteurs dans ce cas.
Bonjour thev en effet il s'agit d'un lecteur réseau (local) mais je pense que la lenteur se fait surtout au niveau du nombre de sous dossier je test actuelement ce code mais qui a tendance a planté des qu'il y a un caractere special dans le nom de fichier ou de dossier
Sub Retrieve_File_listingV2()
Application.screenupdateing = false
Cells(1,2) = Timer
Call Enlist_DirectoriesV2("Y:\")
Cells(Cells(Rows.Count, 2).End(xlUp).Row + 1, 2) = Timer - Cells(1,2)
Application.screenupdateing = true
End Sub
Public Sub Enlist_DirectoriesV2(strPath As String)
Dim strFldrList() As String
Dim lngArrayMax, x As Long
lngArrayMax = 0
strFn = Dir(strPath & "*.*", 23)
While strFn <> ""
If strFn <> "." And strFn <> ".." Then
If (GetAttr(strPath & strFn) And vbDirectory) = vbDirectory Then
lngArrayMax = lngArrayMax + 1
ReDim Preserve strFldrList(lngArrayMax)
strFldrList(lngArrayMax) = strPath & strFn & "\"
Elseif instr(strfn, "SLDDRW") <> 0 then
Cells(Cells(Rows.Count, 2).End(xlUp).Row + 1, 2) = strPath & strFn
End If
End If
strFn = Dir()
Wend
If lngArrayMax <> 0 Then
For x = 1 To lngArrayMax
Call Enlist_DirectoriesV2(strFldrList(x))
Next
End If
End Sub
Pour analyser 87000 Fichier sur le réseau il met environ 4 Minute v'est déjà mieux