Update: Macro para Localizar arquivos no Computador – Busca mp3

Olá pessoal.
Recebi alguns comentários a respeito do artigo publicado ontem: Macro para Localizar arquivos no Computador e listar na planilha.
Então. Tinha deixado para fazer uma postagem futura sobre outra maneira de manipular arquivos diretamente por macros do Excel, mas, como o código postado na matéria anterior não se aplica as versões mais recentes do Excel, como o Excel 2010, por exemplo, vou dar uma pincelada sobre outro método de manipulação de arquivos e pastas do computador.
No final do artigo vou disponibilizar o arquivo para vocês baixarem e testarem, ok.
Começo falando sobre o objeto que vamos utilizar, o FileSystemObject, contudo, serei bem suscinto, visto que, o foco deste artigo é apenas um update da matéria anterior.

O objeto FileSystemObject

O FileSystemObject (FSO) permite a manipulação de arquivos e pastas em seu computador. Ações como copiar, mover ou excluir arquivos, criar pastas, verificar a existência de arquivos ou pastas ou acessá-los via comandos, fazem parte de suas funcionalidades.
Para ativarmos o uso deste objeto em nossas macros, precisamos referênciá-lo em nosso projeto VBA. Como fazer isto? Siga as etapas abaixo.

  1. Acesse o ambiente VBA. (Atalho: ALT+F11)
  2. Clique no item “Referências…” do menu Ferramentas.
  3. Procure o item “Microsoft Scripting Runtime”, marque-o e clique em Ok.



 
Fazendo isso, você poderá utilizar todas os métodos e propriedade do FSO. Em nosso projeto de macro, vamos utilizar bastante a leitura de pastas, para fazermos a varredura em busca dos arquivos .mp3 (das músicas) e as propriedades dos arquivos, para extrairmos os nomes e tamanhos dos arquivos encontrados.
Para utilizarmos o FSO, precisamos criar uma variável deste tipo, como por exemplo:

Dim fso As FileSystemObject
Set fso = New FileSystemObject

Com este objeto vamos manipular todos os métodos e propriedades disponíveis nesta biblioteca.

Construindo a macro

Bem, o objetivo desta macro é buscar nas pastas de seu computador, de preferência a pasta Minhas Músicas (que é o tópico deste artigo) por suas músicas no formato Mp3. Isto é apenas uma forma prática de utilizar o que estamos aprendendo hoje, ok. O FSO serve para manipular qualquer tipo de arquivo e você pode alterar o código para atender a sua necessidade.
Estamos dando continuação ao arquivo publicado anteriormente. Para que ainda não leu, leia agora.
Precisaremos de dois módulos. Um deles será apenas para fornecer acesso a API para exibir a tela para escolha da pasta onde buscar os arquivos.
MóduloPesquisa

Private sh As Worksheet
Private iTotalEncontrado As Long
Private iLinha As Long
Private iSomaMb As Double
Sub Listar_arquivos_mp3()
Dim i As Long
Dim sPasta As Variant
Dim sBuscarPor As String
Dim fsoPasta As Folder
Dim fso As FileSystemObject
    Set sh = ThisWorkbook.ActiveSheet
    iTotalEncontrado = 0
    iSomaMb = 0
    iLinha = 5      'Define a linha inicial da listagem
    'Exibe a caixa para escolha da pasta onde será feita a pesquisa
    sPasta = GetPasta
    If sPasta = "" Then
        Exit Sub        'Cancela pesquisa
    End If
    'Define o termo da pesquisa
    sBuscarPor = "*.mp3"
    'Apaga o conteúdo
    sh.Range("B:C").EntireColumn.ClearContents
    'Escreve o cabeçalho
    sh.Cells(4, 2).Value = "Música"
    sh.Cells(4, 3).Value = "Tamanho (Mb)"
    Application.StatusBar = "Aguarde... Pesquisando ... "
    Set fso = New FileSystemObject
    Set fsoPasta = fso.GetFolder(sPasta)
    'Chama o método que faz a varredura na pasta
    Call BuscarfsoArquivos(fsoPasta, sBuscarPor)
    sh.Cells(1, 2).Value = "Músicas em " & sPasta
    sh.Cells(2, 2).Value = "Total de Músicas: " & iTotalEncontrado
    sh.Cells(3, 2).Value = "Espaço Utilizado: " & Format(iSomaMb, "0.00") & " MB"
    sh.Range("A1").Select
    Application.StatusBar = False
    MsgBox "Pesquisa concluída.", vbInformation
End Sub
Private Sub BuscarfsoArquivos(ByVal fsoPasta As Folder, ByVal sBuscarPor As String)
Dim fsoArquivo As File
Dim fsoSubPasta As Folder
Dim fso As FileSystemObject
On Error GoTo erro
    Set fso = New FileSystemObject
    Application.StatusBar = "Procurando em " & fsoPasta.path & " ..."
    For Each fsoArquivo In fsoPasta.Files
        If fsoArquivo.Name Like sBuscarPor Then
            sh.Cells(iLinha, 2).Value = fsoArquivo.path
            sh.Cells(iLinha, 3).Value = CDbl(Format((fsoArquivo.Size / 1048576), "0.00"))
            iSomaMb = iSomaMb + sh.Cells(iLinha, 3).Value
            iLinha = iLinha + 1
            iTotalEncontrado = iTotalEncontrado + 1
        End If
        Application.StatusBar = "Procurando em " & fsoPasta.Name & ": Encontrados " & iTotalEncontrado & " em " & fsoPasta.Files.Count & " arquivos"
    Next
    For Each fsoSubPasta In fsoPasta.SubFolders
        Call BuscarfsoArquivos(fsoSubPasta, sBuscarPor)
    Next
Exit Sub
erro:
    Exit Sub
End Sub

MóduloAPI

'Declarações API
Private Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
    (lpBrowseInfo As BROWSEINFO) As Long
Declare Function SHGetPathFromIDList Lib "shell32" (ByVal itemID As Long, ByVal path As String) As Long
Private Const BIF_RETURNONLYFSDIRS = &H1
Function GetPasta() As String
    Dim bnfo As BROWSEINFO
    Dim sCaminho As String
    Dim lIndice As Long
    Dim vJanela As Variant
    Dim iPosicao As Integer
    Dim sPasta As String
    sPasta = ""
    'A pasta raiz é o Desktop:
    bnfo.pidlRoot = 0&
    'Título
    bnfo.lpszTitle = "Selecione a pasta onde procurar"
    'Tipo de dado retornado:
    bnfo.ulFlags = &H1
    'Mostra a janela:
    vJanela = SHBrowseForFolder(bnfo)
    'Analisa e trata o resultado:
    sCaminho = Space(512)
    lIndice = SHGetPathFromIDList(ByVal vJanela, ByVal sCaminho)
    If lIndice Then
        iPosicao = InStr(sCaminho, Chr(0))
        sPasta = Left(sCaminho, iPosicao - 1)
    End If
    GetPasta = sPasta
End Function

Crie um botão na planilha onde será listado resultado da pesquisa e atribua a chamada para a macro Listar_arquivos_mp3(). Essa macro solicitará ao usuário que informe a pasta onde serão buscados os arquivos .mp3. Selecione a pasta Minhas Músicas, de preferência, mas, você pode escolher o HD, C:\, porém, irá demorar bastante.
 
O FSO pode ser usado em todas as versões do Excel, por isso, quis utilizá-lo em alternativa para o uso que fizemos no outro artigo.
Então é isso!!!
Até mais. E não esqueçam de nos acompanhar pelo twitter, ok.

24 comentários em “Update: Macro para Localizar arquivos no Computador – Busca mp3”

  1. Reinaldo,
    Excelente macro, funciona muito bem, obrigado por compatilhar.
    Haveria alguma maneira fácil de implementar à macro a funcionalidade de transformar o caminho dos arquivos gerados na planilha, automaticamente em hyperlinks para abrir esses arquivos?
    Saudações,

    Responder
    • Sim, Renato.
      Substitua a linha com o comando:
      sh.Cells(iLinha, 2).Value = fsoArquivo.path
      Por:
      With sh.Cells(iLinha, 2)
      .Value = fsoArquivo.path
      .Worksheet.Hyperlinks.Add Anchor:=sh.Cells(iLinha, 2), Address:=fsoArquivo.path, TextToDisplay:=fsoArquivo.path
      .Font.Size = 8
      .Font.ColorIndex = 0
      End With

      Abç

      Responder
      • Ola Carlos o erro que nosso amigo se refere é:
        Erro de compilação:
        O código desse projeto deve ser atualizado para uso em sistemas de 64bits, analise e atualize as instruções declare e em seguida em seguida marque-as com o atributo PtrSafe.
        dá erro na linha
        Private Declare Function SHBrowseForFolder Lib “shell32.dll” Alias “SHBrowseForFolderA” _
        (lpBrowseInfo As BROWSEINFO) As Long
        Declare Function SHGetPathFromIDList Lib “shell32” (ByVal itemID As Long, ByVal path As String) As Long
        dá erro em pc de 64btis

        Responder
        • Olá pessoal.
          Experimentem trocar o código da definição das variáveis de chamada da API no MóduloAPI.
          Substitua pelo código abaixo:

          
          #If VBA7 Then
              Private Type BROWSEINFO
                  hOwner As LongPtr
                  pidlRoot As LongPtr
                  pszDisplayName As String
                  lpszTitle As String
                  ulFlags As Long
                  lpfn As LongPtr
                  lParam As LongPtr
                  iImage As Long
              End Type
              Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
                  (lpBrowseInfo As BROWSEINFO) As LongPtr
              Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
                  (ByVal pidl As LongPtr, ByVal pszPath As String) As Boolean
          #Else
              Private Type BROWSEINFO
                  hOwner As Long
                  pidlRoot As Long
                  pszDisplayName As String
                  lpszTitle As String
                  ulFlags As Long
                  lpfn As Long
                  lParam As Long
                  iImage As Long
              End Type
              Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
                  (lpBrowseInfo As BROWSEINFO) As Long
              Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
                  (ByVal pidl As Long, ByVal pszPath As String) As Boolean
          #End If
          Private Const BIF_RETURNONLYFSDIRS = &H1
          

          Um abraço

          Responder
  2. Reinaldo,
    Excelente artigo!!! Tenho feito bom uso do mesmo e diversas alterações para as minhas necessidades, porém estou “batendo cabeça” em conseguir que a macro recupere outras informações do arquivo, principalmente mp3. Como consigo, por exemplo, além do nome e tamanho, incluir o Artista, álbum, etc?

    Responder
    • Caro Daniel.
      Ficou um pouco vago como você pretende fazer ou aplicar isso, contudo, pelo que entendi, é bem mais simples que a macro descrita neste artigo.
      Você vai precisar:

      Mas, como disse, não compreendi bem como quer fazer isso. Se quiser, explicar melhor e enviar uma planilha pra que eu possa complementá-la com a macro, faça isso clicando aqui.
      Um abraço

      Responder

Deixe um comentário