Home Excel - Dicas Microsoft Excel VBA Excel VBA - Arquivos Excel vba arquivos lista todos os arquivos na unicade c

Excel vba arquivos lista todos os arquivos na unicade c

E-mail Imprimir PDF

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

Última atualização em Qua, 10 de Agosto de 2011 08:04  

Adicionar comentário

"Jamais considere seus estudos como uma obrigação, mas como uma oportunidade invejável para aprender a conhecer a influência libertadora da beleza do reino do espírito, para seu próprio prazer pessoal e para proveito da comunidade." Albert Einstein


Código de segurança
Atualizar

PROMOÇÃO DIDÁTICOS SABEREXCEL



Adquira já o Acesso Imediato
à Area de Membros

Compra Grantida --- Entrega Imediata

Aprenda Excel VBA com Simplicidade de 
códigos e Eficácia, Escrevendo Menos e
Fazendo Mais.

'-------------------------------------'
Entrega Imediata:
+  500 Video Aulas MS Excel VBA
+  35.000 Planilhas Excel e VBA
+  Coleção 25.000 Macros MS Excel VBA
+  141 Planilhas Instruções Loops
+  341 Planilhas WorksheetFunctions(VBA)
+    04 Módulos Como Fazer Excel VBA
+  Curso Completo MS Excel VBA
+  Planilhas Inteligentes


Pesquisa Google SaberExcel

Publicidade Google

<script type="text/javascript"><!--

google_ad_client = "ca-pub-2317234650173689";

/* retangulo 336 x 280 */

google_ad_slot = "0315083363";

google_ad_width = 336;

google_ad_height = 280;

//-->

</script>

<script type="text/javascript"

src="http://pagead2.googlesyndication.com/pagead/show_ads.js">

</script>

Publicidade

RSFirewallProtected


Google Associados

Depoimentos

Adicione Saberexcel Favoritos

 
 

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel,


   Sobre as WorksheetFunctions Funções de Planilhas que retornam valores do VBA