Hoje vamos ver um truque muito bacana e útil, principalmente, para quem cria planilhas mais complexas e que interage com outras funções da sua máquina. Vamos aprender a criar uma planilha que exibe o conteúdo de qualquer pasta do seu pc.

O segredo está no código VBA que vamos inserir. Portanto, se você não sabe como inserir as macros e Vba’s confira esta aula. Veja o código que vamos colar no local "EstaPasta_de_trabalho" dentro da edição de VBA:

Sub Lista_Arquivos_nas_pastas()
   Dim RootFolder$
   RootFolder = Localiza_Dir
      If RootFolder = "" Then Exit Sub
      Workbooks.Add
         With Range("A1")
            .Formula = "Arquivos do Diretório: " & 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 Acesso: "
     Range("E3").Formula = "Data última Modificação: "
         With Range("A3:E3")
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = True
         End With
   ListFilesInFolder RootFolder, True
   Columns("A:H").AutoFit
End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
   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
   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"
   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&, "Procurar por um Diretório", &H1&)
   On Error Resume Next
   chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
   If objFolder.Title = "Bureau" Then
      chemin = "C:WindowsBureau"
   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

Pronto, galera. Está pronto o "truque". Sugiro que você crie um botão e atribua a ele a macro que acabamos de criar. Após você fazer isso e clicar no dito botão vai aparecer aquela janelinha do Windows que já conhecemos e que serve para navegar entre a hierarquia de pastas. A janelinha é a seguinte:

Selecionei uma pasta e o resultado foi esse:

Mensagem de Erro

Em alguns computadores poderá ser exibida a seguinte mensagem de erro após executar o código e selecionarmos a passa a ser vasculhada:

Nesse caso você irá novamente n parte de edições de macro e lá irá em "Ferramentas", depois em "Referências...", irá abrir uma janelinha com diversas opções. Marque a opção "Microsoft Scripting Runtime", dê um ok e pronto.

Agora faça o teste. A planilha estará funcionando como no exemplo acima.

Passo necessário Excel 2007

Atenção para você que usa Excel 2007. Será necessário 1 passo extra descoberto pelo nosso leitor Maurício Araújo.

Faça o seguinte: Vá no menu "Executar" e selecione a opção "Redefinir". Após fazer isto será aberta a opção "Referência" do menu "Ferramentas". 

Espero que tenham gostado da dica.