Listar arquivos de um diretorio

[lupe]

Olá!
Tomás, eu não consegui adaptar os codigos que voce postou sobre "listar arquivos de um diretorio".
Voce poderia disponibilizar um arquivo exemplo, isso facilitaria muito pra mim, ou se preferir,
me mandar no email: ronny_lupe@hotmail.com.

Desde ja, agradeço.

Abraço!

[webmaster]

Lupe,

Só para confirmação, seria adaptar para o Access?

Abraços

[lupe]

Ola webmaster!

Na verdade esse codigo ja é do access, eu nao consegui adaptar no meu programa. Esse codigo é de um formulario que tem a funçao de visualizar arquivos PDF e o Tomás fez uma implementação onde ele busca de uma determinada pasta todos os arquivos PDF e lista-os em uma ComboBox. É isso que eu não consegui fazer. Por isso estou pedindo um arquivo exemplo, isso facilitaria pra mim.

Obrigado pelo retorno.

[webmaster]

Lupe,

Só para esclarecer:

Webmaster = Tomás

Pode colocar o exemplo do código aqui para trabalharmos em cima dele?

Abraços

[lupe]

Ola Tomás!

O codigo é o seguinte:

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

e

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

Tomás, cheguei até o seu forum atraves do seguinte comentario feito pelo Marcio Melo no site usandoaccess:

Hoje, aproveitei para implementar essa grande dica com muito estilo, adicionei em meu projeto um simples leitor PDF apontando como você sugiriu para uma pasta [artigo] e para complementar coloquei uma combobox listando todos os artigos desta pasta, bastando o leitor escolher e pronto já esta ao seu alcance a leitura do pdf - nesse link tem como listar os arquivos de um diretório (http://www.tomasvasquez.com.br/blog/mic ... -diretorio) para ajudar vou deixar aqui parte de como fiz a chamada da função para montar a lista, olhem o resto da função no link

Dim arquivos() As String
Dim listagem As Variant
Dim lCtr As Long
arquivos = ListaArquivos(origem)
For lCtr = 0 To UBound(arquivos)
' Debug.Print arquivos(lCtr) & ";" 'RowSource - separar por ponto e virgula
listagem = listagem & arquivos(lCtr) & ";"
Next
Me.Comb1.RowSource = listagem
lembrar que na combobox, deve estar configurada para lista de valores.

Então, Avelino resolvi seguir o seu conselho e nesta pasta artigos vou colocar os pdf relacionado a ajuda do programa de maneira que a própria empresa possa fazer esse tutorial.

Abraço

[webmaster]

Lupe,

Veja se o anexo atende ao que deseja.

Abraços

[lupe]

Olá Tomás!

É exatamente isso que eu precisava.

Muito obrigado pela força.

Abraço e sucesso!

[rfdoss]

Olá parabens pelo exemplo! funciona perfeitamente.

Só uma dúvida seria possivel implementar à opção de pesquisar tbm nas subpastas ?

Assim o usuário poderia especificar o diretório principal e o sistema vaz a varredura na pasta e sub pastas.

Renato.

[webmaster]

Renato,

Fiz uma mudança no código e parece ter funcionado:

Código: Selecionar todos

Public Function ListaArquivos(ByVal Caminho As String) As String()
'Atenção: Faça referência à biblioteca Microsoft Scripting Runtime
    Dim FSO As New FileSystemObject
    Dim result() As String
    Dim Pasta As Folder
    Dim Arquivo As File
    Dim SubPasta As Folder
    Dim Indice As Long


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

        ' chama o código para todas as subpastas
        For Each SubPasta In Pasta.SubFolders
            Dim subresult() As String
            subresult = ListaArquivos(SubPasta.Path)
            Call ArrayMerge(subresult, result, False)
        Next

        For Each Arquivo In Pasta.Files
            'Indice = IIf(result(0) = "", 0, Indice + 1)
            Indice = UBound(result)
            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

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


Public Sub ArrayMerge(SourceArray As Variant, DestArray As Variant, Optional KillSource As Boolean = False)

'MERGES TWO ARRAYS
'SourceArray is appended to end of DestArray
'If KillSource is set to true, then SourceArray
'is erased following the merge

'EXAMPLE

'Dim i(2) As Integer
'Dim j() As Integer
'Dim iCtr As Integer
'
'ReDim j(2) As Integer
'i(0) = 4
'i(1) = 5
'i(2) = 6
'j(0) = 1
'j(1) = 2
'j(2) = 3
'ArrayMerge i, j
'
'For iCtr = 0 To UBound(j)
' Debug.Print j(iCtr) 'Outputs 1 2 3 4 5 6
'Next

    Dim l As Long, lngPos As Long, lngTemp As Long
    Dim lngUboundSource As Long
    Dim lngLBoundSource As Long
    Dim lngUboundDest As Long


    If (Not IsArray(SourceArray)) Or (Not IsArray(DestArray)) _
       Then Exit Sub

    lngLBoundSource = LBound(SourceArray)
    lngUboundSource = UBound(SourceArray)
    lngUboundDest = UBound(DestArray)
    lngTemp = lngUboundSource - lngLBoundSource + 1

    lngPos = UBound(DestArray) + 1

    ReDim Preserve DestArray(LBound(DestArray) To _
                             UBound(DestArray) + lngTemp)

    For l = lngUboundDest To lngPos Step -1
        DestArray(l + lngTemp) = DestArray(l)
    Next

    lngUboundSource = lngPos + lngTemp - 1

    For l = lngPos To lngUboundSource
        DestArray(l) = SourceArray(l - lngPos)
    Next

    If KillSource = True Then Erase SourceArray
End Sub

Peguei a função ArrayMerge aqui:

http://www.freevbcode.com/ShowCode.asp?ID=2874

Abraços