Detalhes de vba arquivos retorna o total de arquivos xls existentes em determinado diretorio

PropriedadeValor
Nome:vba arquivos retorna o total de arquivos xls existentes em determinado diretorio
Descricao:

Saberexcel - o site das macros

Macros do Aplicativo Microsoft Excel VBA, lista os arquivos de um determinado (escolhido) diretório

Sub Testar_Lista_Arquivos_nas_pastas()
Dim RootFolder$

'Diretório à scanear
RootFolder = Localiza_Dir

If RootFolder = "" Then Exit Sub
' criando novo Workbook para receber a lista
Workbooks.Add
' Adicionando Cabeçalho

With Range("A1")
.Formula = "Contendo os Diretórios : " & RootFolder
.Font.Bold = True
.Font.Size = 12
End With

Range("A3").Formula = "Caminho: "
Range("B3").Formula = "Nome : "
Range("C3").Formula = "Data Criação : "
Range("D3").Formula = "Data último Accesso : "
Range("E3").Formula = "Data última Modificação : "


With Range("A3:E3")
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True

End With

' list all files included subfolders

ListFilesInFolder RootFolder, True
Columns("A:H").AutoFit

End Sub

'
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True

Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long


Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)

r = Range("A65536").End(xlUp).Row + 1

For Each FileItem In SourceFolder.Files
'display file properties

Cells(r, 1).Formula = FileItem.ParentFolder
Cells(r, 2).Formula = FileItem.Name
Cells(r, 3).Formula = FileItem.DateCreated
Cells(r, 3).NumberFormatLocal = "dd / mm / aaaa"
Cells(r, 4).Formula = FileItem.DateLastAccessed
Cells(r, 5).Formula = FileItem.DateLastModified
Cells(r, 5).NumberFormatLocal = "dd / mm / aaaa"
' next row number

r = r + 1
Next FileItem

If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If

Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing

ActiveWorkbook.Saved = True

End Sub

 

Private Function Localiza_Dir()
Dim objShell, objFolder, chemin, SecuriteSlash

Set objShell = CreateObject("Shell.Application")
Set objFolder = _
objShell.BrowseForFolder(&H0&, "Saberexcel - Procurar por um Diretório", &H1&)
On Error Resume Next

chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""

If objFolder.Title = "Bureau" Then
chemin = "C:\Windows\Bureau"
End If

If objFolder.Title = "" Then
chemin = ""
End If


SecuriteSlash = InStr(objFolder.Title, ":")
If SecuriteSlash > 0 Then
chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If

Localiza_Dir = chemin

End Function

 

 

Aprenda Microsoft Excel VBA





Nome do arquivo:vba arquivos mostram todos arquivos em diretorio.zip
Tamanho: Vazio
Tipo:zip (Tipo de Mime: application/zip)
Autor:SaberExcel
Criado em: 17/11/2010 16:53
Visitas:Todos
Responsavel:Editor
Acessos:1719 Acessos
Atualizado em: 17/11/2010 16:54
Site: