Kioskea
Recherche
Faça uma pergunta »

VBA VB6 - Ler todos os arquivo, diretórios e subdiretórios

Março 2015


A função Scripting.FileSystemObject substitui, vantajosamente, a função Application.FileSearch que, aliás, não está mais disponível no Office 2007.
Um exemplo para salvar todos os arquivos de imagens de um diretório.
Colar em um módulo .bas :

Option Explicit       
Dim Data()       
Dim NBdata As Integer       

'Obter todos os arquivos de um diretório e, se for o caso, dos subdiretórios       
'Si Subdiretório = true       
'O diretório de origem deve ficar em Rep       
Public Function LerDiretório (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 'os arquivos do diretório principal       
    If SousRep Then 'os arquivos dos sub- diretórios
        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 à adaptar       
            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


Salve também as informações nos arquivos.
Adaptar conforme suas necessidades.


Para uma leitura offline, é possível baixar gratuitamente este artigo no formato PDF:
Vba-vb6-ler-todos-os-arquivo-diretorios-e-subdiretorios.pdf

A ver igualmente

VBA-VB6 - Read all directories files
Por jak58 em 7 de maio de 2010
VBA VB6 - Leer todos los archivos, carpetas y subcarpetas
Por Carlos-vialfa em 13 de maio de 2010
Artigo original publicado por lermite222. Tradução feita por pintuda.
Este documento, intitulado « VBA VB6 - Ler todos os arquivo, diretórios e subdiretórios »a partir de Kioskea (pt.kioskea.net) está disponibilizado sob a licença Creative Commons. Você pode copiar, modificar cópias desta página, nas condições estipuladas pela licença, como esta nota aparece claramente.