Menu

VBA-VB6 - Read all directories files

USESFRBR
Ask a question



The Scripting.FileSystemObject function replaces Application.FileSearch which is no longer available as from Office 2007
An example on how to store all the image files to a directory.

Paste in a module: 

Option Explicit   
Dim Data()   
Dim NBdata As Integer   

'Optenir tout les fichiers d'un répertoir et éventuellement des sous-répertoirs   
'Si SousRep = true   
'Le répertoir source doit être dans Rep   
Public Function LireRepertoir(ByVal Rep As String, Optional SousRep As Boolean) As Integer   
Dim Obj, RepP, F, S, sf, F1, Fsous   
Dim i As Integer, Ext As String   
Dim Chem As String   
Dim T As Double   
   ' Application.MousePointer = 13 'Pour VB6  
    Set Obj = CreateObject("Scripting.FileSystemObject")   
    Set RepP = Obj.Getfolder(Rep)   
    Chem = Rep: If Right(Chem, 1) <> "\" Then Chem = Chem & "\"   
       
    Set sf = RepP.subfolders   
    Set F = RepP.Files   
    GoSub RempliData 'les fichiers du répertoir principal   
    If SousRep Then 'les fichiers des sous-répertoirs   
        For Each Fsous In sf   
            Set RepP = Fsous   
            Set F = RepP.Files   
            GoSub RempliData   
        Next Fsous   
    End If   
Exit Function   
'**********************************************************************   
RempliData:   
    For Each F1 In F   
        Ext = LCase(Right(F1.Name, 3))   
        If Ext = "bmp" Or Ext = "jpg" Then 'extention à adapter   
            ReDim Preserve Data(5, NBdata)   
            Data(0, NBdata) = F1.Name   
            Data(1, NBdata) = F1.ParentFolder & "\" & F1.Name   
            Data(2, NBdata) = F1.DateCreated   
            Data(3, NBdata) = F1.DateLastAccessed   
            Data(4, NBdata) = F1.DateLastModified   
            T = F1.Size   
            If T < 99999 Then   
                Data(5, NBdata) = T & " Bi"   
            ElseIf T < 999999 Then   
                Data(5, NBdata) = Round(T / 1000, 1) & " Ko"   
            Else   
                Data(5, NBdata) = Round(T / 1000000, 1) & " Mo"   
            End If   
            NBdata = NBdata + 1   
        End If   
    Next F1   
Return   
       
End Function
  • It can also stores information about files.
  • To be adapted as needed.
    Jean-François Pillou

    CCM is a leading international tech website. Our content is written in collaboration with IT experts, under the direction of Jeff Pillou, founder of CCM.net. CCM reaches more than 50 million unique visitors per month and is available in 11 languages.

    Learn more about the CCM team

Related