SaberExcel - Aprenda Excel VBA, Site sobre macros, funções, fórmulas e planilhas do Excel VBA planilhas prontas e apostilas para download

Saberexcel - o site das macros
Esta macro do Aplicativo Microsoft Excel VBA, lista todos os arquivos em "C:\"  - exemplos para montar planilhas excel

Sub Lista_todos_arquivos_C()
  Lister 1, "c:\"
End Sub
 
'* nRow = Linha inicial
'* FolderName = Chemin du répertoire à lister
'* Suffix = Filtre optionnel des types de fichiers
'* SubDir = True pour étendre la liste aux sous-répertoires
 
Sub Lister(nRow&, FolderName$, Optional Suffix$ = "*.*", _
          Optional SubDir As Boolean = True)
Dim i As Long, x As Long, File As String, Folder As String, nbFolders() As String
 
  Cells(nRow, 1) = FolderName
  Cells(nRow, 1).Font.Bold = True
  nRow = nRow + 1
 
  If Not Right(FolderName, 1) = " \ " Then FolderName = FolderName & " \ "
  File = Dir(FolderName & Suffix)

  Do While Len(File) > 0
    Cells(nRow, 1) = FolderName & File
    Cells(nRow, 2) = FileLen(FolderName & File)
    Cells(nRow, 3) = FileDateTime(FolderName & File)
    nRow = nRow + 1: File = Dir
  Loop

  If Not SubDir Then Exit Sub
  x = 0: Folder = Dir(FolderName, vbDirectory)

  Do While Folder > ""
    If Folder <> "." And Folder <> ".." Then
      If (GetAttr(FolderName & Folder) And vbDirectory) = vbDirectory Then x = x + 1
    End If
    Folder = Dir
  Loop

  ReDim nbFolders(x + 1): i = 1
  nbFolders(i) = Dir(FolderName, vbDirectory)

  Do While nbFolders(i) > ""
    If nbFolders(i) <> "." And nbFolders(i) <> ".." Then
      If (GetAttr(FolderName & nbFolders(i)) And vbDirectory) = vbDirectory Then i = i + 1
    End If
    nbFolders(i) = Dir
  Loop

  For i = 1 To UBound(nbFolders()) - 1
    Call Lister(nRow, FolderName & nbFolders(i), Suffix)
  Next
End Sub




Aprenda tudo sobre o Aplicativo Microsoft Excel VBA, sozinho, praticando com os produtos didáticos Saberexcel