Access, Desenvolvimento, Excel, Microsoft Office, VBA, Word

VBA – Listar Arquivos de um diretório

9 Comentários

Mais uma para a caixa de ferramentas de VBA. A macro abaixo retorna um Array de String com a lista de nomes dos arquivos contidos na pasta informada:

Public Function ListaArquivos(ByVal Caminho As String) As String()
    'Atenção: Faça referência à biblioteca Micrsoft Scripting Runtime
    Dim FSO As New FileSystemObject
    Dim result() As String
    Dim Pasta As Folder
    Dim Arquivo As File
    Dim Indice As Long
 
 
    ReDim result(0) As String
    If FSO.FolderExists(Caminho) Then
        Set Pasta = FSO.GetFolder(Caminho)
 
        For Each Arquivo In Pasta.Files
            Indice = IIf(result(0) = "", 0, Indice + 1)
            ReDim Preserve result(Indice) As String
            result(Indice) = Arquivo.Name
        Next
    End If
 
    ListaArquivos = result
ErrHandler:
    Set FSO = Nothing
    Set Pasta = Nothing
    Set Arquivo = Nothing
End Function

A macro abaixo é um exemplo de chamada a função acima, listando os arquivos da pasta C:\temp, como informado no código.

Private Sub ListaArquivos()
    Dim arquivos() As String
    Dim lCtr As Long
    arquivos = ListaArquivos("C:\temp")
    For lCtr = 0 To UBound(arquivos)
      Debug.Print arquivos(lCtr)
    Next
End Sub

Importante: Faça referência à biblioteca Micrsoft Scripting Runtime para ter acesso aos objetos da File System Object (FSO), necessários para execução do exemplo.

Bom proveito!

Comentários

comentários

9 comentários em “VBA – Listar Arquivos de um diretório”

  3. Boa noite. Fiz um teste, colando a macro que lista os arquivos de um diretório, porém a macro não retornou nada. Saberia dizer porquê?
    1) Onde a macro lista o nome dos arquivos do diretório?
    2) O que significa o comando “Debug.Print arquivos(lCtr)”? (esse comando não fez nada). Obrigado

  7. Bom dia!!! Como faço para pesquisar um arquivo em um diretório especifico usando VBA?

    Exemplo:

    Arquivos em c:\teste

    EGV-1234-2012.DOC
    EGV-1235-2012.DOC
    EGV-1236-2012.DOC
    EGV-1237-2012.DOC
    EGV-1238-2012.DOC
    EGV-0000-2012.DOC

    Quero digitar em uma caixa de texto o valor “EGV-123” e o sistema deverá retornar apenas os 5 primeiros arquivos da lista. Existe alguma função pronta para o evento???

    😀

  9. Boa tarde a todos.. Consegui resolver.. Caso alguem tenha essa dúvida, segue solução…. 😀

    Modulo M_ListaArquivos criado no access

    Option Compare Database

    Global arq_proc, mypos, total_listado As String

    Public Function ListaArquivos(ByVal Caminho As String) As String()
    ‘Atenção: Faça referência à biblioteca Micrsoft Scripting Runtime
    Dim FSO As New FileSystemObject
    Dim result() As String
    Dim Pasta As Folder
    Dim arquivo As File
    Dim Indice As Long
    Dim Contador As Integer

    Contador = 0
    ReDim result(0) As String
    If FSO.FolderExists(Caminho) Then
    Set Pasta = FSO.GetFolder(Caminho)

    For Each arquivo In Pasta.Files
    Indice = IIf(result(0) = “”, 0, Indice + 1)
    ReDim Preserve result(Indice) As String
    result(Indice) = arquivo.Name

    mypos = InStr(arquivo.Name, arq_proc) ‘retorna posicao do caracter, caso o encontre na string

    If arq_proc = “” Then
    mypos = 0
    End If

    If mypos 0 Then
    Form_FRM_BUSC_EMAIL_CONTRATADA.lstemail.AddItem arquivo.Name
    Contador = Contador + 1
    End If

    Next
    End If

    total_listado = Contador
    ListaArquivos = result
    ErrHandler:
    Set FSO = Nothing
    Set Pasta = Nothing
    Set arquivo = Nothing
    End Function

    ‘Evento clicar do Botão buscar

    Private Sub buscar_Click()

    txtarquivo.SetFocus
    If txtarquivo.Text = “” Then
    MsgBox (“Informe o conteudo de busca”)
    Exit Sub
    End If

    Dim i As Integer

    If lstemail.ListCount 0 Then
    For i = 0 To lstemail.ListCount – 1
    lstemail.RemoveItem (0)
    Next
    End If

    LOCAL_RECEBIDOS = “c:\teste”
    arq_proc = “EGV-123″
    Call ListaArquivos(LOCAL_RECEBIDOS)

    item.Caption = lstemail.ListCount & ” Itens na Lista”

    End Sub

Os comentários estão fechados.