[Resolvido]Ler diretorios

como que eu faco pra ler um diretorios e contar os arquivos nele e montar uma barra de processo pra copiar de uma pasta pra outra?

alguem tem alguma ideia como fazer isso????

Para contar os ficheiros numa pasta, tem de colar esta função num modulo;

Public Function ContaFicheiros(strCaminho As String) As Long
'By JPaulo ® Maximo Access
'Requer a seguinte referência VBA ativa:
'Microsoft Scripting Runtime
'Para chamar a função, deve colocar no pressionar de um botão: Call ContaFicheiros("C:\SuaPasta")
Dim fso As Object
Dim strPasta As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set strPasta = fso.GetFolder(strCaminho)
ContaFicheiros = strPasta.Files.Count
MsgBox "Encontrados " & ContaFicheiros & " ficheiros." & vbNewLine & " na pasta " & strCaminho, vbInformation
Set strPasta = Nothing
Set fso = Nothing
End Function

Grande JPaulo, há quanto tempo não trocamos umas idéias.

Este tópico vei a calhar, e lhe pergunto:

Além de contar os ficheiros o Grande Mestre teria uma forma de armazenar numa tabela o nome desses ficheiros?

Grande abraço e um beijo em vosso coração.         

WSenna

Ola grande e velho amigo.

Este topico ja estava perdido, por falta de retorno dos que pedem, levam e nem agradecem, enfim......

É possivel sim, amanhã posto aqui a solução.

Fiquei morando na fazenda e la nao tinha net, obrigado pelo retorno

wsenna, faça o teste por favor;

Código:

Public Function ContaFicheiros(strCaminho As String) As Long
'By JPaulo ® Maximo Access
'Requer a seguinte referência VBA ativa:
'Microsoft Scripting Runtime
'Para chamar a função, deve colocar no pressionar de um botão: Call ContaFicheiros("C:\SuaPasta")
Dim fso As Object
Dim strPasta As Object
Dim i As Integer
Dim strFicheiro As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set strPasta = fso.GetFolder(strCaminho)
ContaFicheiros = strPasta.Files.Count

MsgBox "Encontrados " & ContaFicheiros & " ficheiros." & vbNewLine & " na pasta " & strCaminho, vbInformation

'Percorre a drive e extraí o nome dos ficheiros
 For Each x In strPasta.Files
        strFicheiro = x.Name
'Insere na tabela os nomes dos ficheiros encontrados
 CurrentDb.Execute "INSERT INTO SuaTabela (SeuCampoNaTabela) Values('" & strFicheiro & "')"
 Next x

Set strPasta = Nothing
Set fso = Nothing
End Function

Esse é o Cara !!!

Grande Mestre, não podia esperar outra coisa, funfou de forma esplêndida.
Agora, não querendo ser abusado, mas já o sendo, se eu quizesse listar sub-pastas dentro de uma pasta, teria alguma modificação a fazer?

De qualquer forma, fico-lhe devendo mais esta.

Abraços, e um beijão em vosso coração.

WSenna

Bom dia Grande;

Apenas estas linha será modificada;

De:
For Each x In strPasta.Files

Para:
For Each x In strPasta.SubFolders

Valew meu Gurú.

Tenha um ótimo final de semana, com muito sol e alegrias mil.

Abração, WSenna

olá pessoal

Jpaulo
com esse codigo, eu conseguiria guardar o caminho completo dos arquivos dentro de uma determinada pasta e subpastas?

Ola;

Consegue sim, desta forma;

Código:

Public Function ContaFicheirosExtraiNome(strCaminho As String) As Long
'By JPaulo ® Maximo Access
'Requer a seguinte referência VBA ativa:
'Microsoft Scripting Runtime
'Para chamar a função, deve colocar no pressionar de um botão: Call ContaFicheirosExtraiNome("C:\SuaPasta")
Dim fso As Object
Dim strPasta As Object
Dim i As Integer
Dim strFicheiro As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set strPasta = fso.GetFolder(strCaminho)
'ContaFicheiros = strPasta.Files.Count

'MsgBox "Encontrados " & ContaFicheiros & " ficheiros." & vbNewLine & " na pasta " & strCaminho, vbInformation

'Percorre a drive e extraí o nome dos ficheiros
 For Each x In strPasta.Files
         strFicheiro = x
'Insere na tabela os nomes dos ficheiros com as extensões, encontrados
 CurrentDb.Execute "INSERT INTO SuaTabela (SeuCampoNaTabela) Values('" & strFicheiro & "')"
 Next x

Set strPasta = Nothing
Set fso = Nothing
End Function


Para chamar a função no seu botão do formulario, tem de invocar as pastas;

Private Sub SeuBotão_Click()
   Call ContaFicheirosExtraiNome("C:\Pasta\Pasta1\Pasta2\")
End Sub

Estava pensando o seguinte. em uma pasta determinada, seria verificada todos os arquivos inclusive dentro de subpastas, e encontrando os arquivos seria salvo altomaticamente o caminho com o nome do arquivo, para posterior consulta, ou até mesmo pré visualização em pdf. a visualização em pdf já tenho, peguei um exemplo do amigo plinio

Para chamar a função:

Private Sub SeuBotão_Click()
'Drive onde está a pasta, pasta e se quiser ler as subpastas (True), senão quiser, altere para (False)
    Call ContaFicheirosExtraiNome("C:\SuaPasta\", True)
End Sub

Código:

Public Function ContaFicheirosExtraiNome(strCaminho As String, strIncluiSubPastas As Boolean)
'By JPaulo ® Maximo Access
'Requer a seguinte referência VBA ativa:
'Microsoft Scripting Runtime
'Para chamar a função, deve colocar no pressionar de um botão: Call ContaFicheirosExtraiNome("C:\SuaPasta\",True)
Dim FSO As Object, strPasta As Object, strSubPasta As Object, strFicheiro As Object
Dim strConta As Long, strSQL As String
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set strPasta = FSO.GetFolder(strCaminho)
    'Percorre a drive e extraí o nome das pastas, subPastas e ficheiros
    For Each strFicheiro In strPasta.Files
    'Insere na tabela o caminho completo dos ficheiros com as extensões, encontrados
                CurrentDb.Execute "INSERT INTO SuaTabela (SeuCampoNaTabela) SELECT '" & strPasta.Path & "\" & strFicheiro.Name & "'"
        strConta = strConta + 1
    Next strFicheiro
    'Se existirem subpastas, insere na tabela o caminho completo dos ficheiros
    If strIncluiSubPastas = True Then
        For Each strSubPasta In strPasta.SubFolders
            ContaFicheirosExtraiNome strSubPasta.Path, True
        Next strSubPasta
    End If
    Set strFicheiro = Nothing
    Set strPasta = Nothing
End Function


Grande JPaulo, isso vai longe.

Imagine: Um acervo microfilmado, quando examinamos esse acervo vemos que se trata de uma Pasta (Medicina), dentro dela várias outras pastas (Alunos) e dentro de cada uma delas os documentos pertinentes a esses alunos (imagens tif) Histórico escolar, outros documentos, etc.
Será que o Access poderia gerenciar tudo isso como se fosse um GED?
Creio que sim, juntando inúmeros eemplos que encontramos neste Forum chegaríamos lá não?

Abraços, WSenna

é justamente isso que estou a desenvolver aqui, percorro o diretorio pelo menos uma vez, cadastro os caminhos e nomes dos arquivos em pdf ou tif, depois faço o cadastro dos dados.

Ivan Felipe, fez o teste da ultima alteração ?

Olá a todos, marquei só para acompanhar este tópico.
Excelente contribuição.
Abraço

Se pretender apenas os .PDF ou .TIF, será assim;

Código:

Public Function ContaFicheirosExtraiNome(strCaminho As String, strIncluiSubPastas As Boolean)
'By JPaulo ® Maximo Access
'Requer a seguinte referência VBA ativa:
'Microsoft Scripting Runtime
'Para chamar a função, deve colocar no pressionar de um botão: Call ContaFicheirosExtraiNome("C:\SuaPasta\",True)
Dim FSO As Object, strPasta As Object, strSubPasta As Object, strFicheiro As Object
Dim strConta As Long, strSQL As String
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set strPasta = FSO.GetFolder(strCaminho)
    'Percorre a drive e extraí o nome das pastas, subPastas e ficheiros
    For Each strFicheiro In strPasta.Files
   
    'Insere na tabela o caminho completo dos ficheiros com as extensões PDF
            If Mid([strFicheiro], InStrRev([strFicheiro], "\") + 1) Like "*.pdf*" Then
                CurrentDb.Execute "INSERT INTO SuaTabela (SeuCampoNaTabela) SELECT '" & strPasta.Path & "\" & strFicheiro.Name & "'"
        strConta = strConta + 1
        Else
        End If
    Next strFicheiro
    'Se existirem subpastas, insere na tabela o caminho completo dos ficheiros
    If strIncluiSubPastas = True Then
        For Each strSubPasta In strPasta.SubFolders
            ContaFicheirosExtraiNome strSubPasta.Path, True
        Next strSubPasta
    End If
    Set strFicheiro = Nothing
    Set strPasta = Nothing
End Function

Private Sub SeuBotão_Click()
'Drive onde está a pasta, pasta e se quiser ler as subpastas (True), senão quiser, altere para (False)
    Call ContaFicheirosExtraiNome("C:\SuaPasta\", True)
End Sub

estarei testando ainda hoje, é que estou terminando a parte dos cadastro de indexação do documento em pdf. utlizarei o codigo da mensagem numero 19.

Aguardamos então o seu retorno.

Olá Mestre, boa tarde.

Amigão, se me permite, eu já fiz os testes e funfou perfeito.

Grande abraço, WSenna

Muito obrigado pelo retorno amigão, fico feliz e o forum agradece.

JPaulo

Deu certinho, mas se for arquivos em um servidor com a pasta compartilhada exemplo

\\microfilm\microfilm-E

mudei a linha para

Call ContaFicheirosExtraiNome("\\microfilm\microfilm-E", True)

travou o sistema.

Olá Ifahidalgo, boa tarde.

Amigão, diga-me lá:

Essa pasta à que você se refere não está vinculada ao seu banco de dados?
No meu caso as pastas estão todas num Backend e são vinculadas ao Frontend. Funfam direitinho.

Abraços, WSenna

resolvido

é que na pasta tinha pra mais de 130 mil pdf, e o sistema travava, quando tentei em uma pasta normal usando o mesmo tipo de caminho \\servidor

Grande JPaulo, muito bom dia.

Amigão, me deparei com um problema que descrevo agora:

Toda subpasta que possua um nome como Michelle Sat'Anna do Porto (note o apóstofre) interompe a captura das demais pastas a seguir.
Com isso, tive que percorrer todas as pastas para retirar o apóstrofe de cada subpasta que o aplicativo encontrou.

Abraços, WSenna

Olá bom dia !

Tem razão, por não esparamos encontrar nomes estranhos...

Com o Replace já resolve;

CurrentDb.Execute "INSERT INTO SuaTabela (SeuCampoNaTabela) SELECT '" & Replace(strPasta.Path, "'", "") & "\" & strFicheiro.Name & "'"

Grande JPaulo, bom dia.

Amigão, já havia pensado nessa solução e realmente funfou como esperado, entretanto, (sempre tem um entretanto não é mesmo?), as subpastas originais que contém os documentos microfilmados permanecem com apóstrofes e por conseguinte, numa pesquisa avançada os ficheiros não casam ou seja, nome sem apóstrofe na tabela e com apóstrofe nas subpastas originais.
Seria o caso de após a importação das subpastas reverter novamente para nomes com apóstrofes?
Tipo:
CurrentDb.Execute "INSERT INTO tblPastas (Pastas) SELECT '" & Replace(strPasta.path, "'", "%") & "\" & strFicheiro.Name & "'"
e após toda operação
Replace(strPasta.path, "%", "'")

Fico no "aguardo"

Abraços, WSenna

Jpaulo

após executar o codigo da mensagem 19, tem como colocar uma mensagem para informar que já verificou todo o caminho, digo uma informação que terminou o processo?

WSenna, faça por favor o teste com esta pequena diferença e veja como fica na tabela;

Código:

CurrentDb.Execute "INSERT INTO SuaTabela (SeuCampoNaTabela) SELECT '" & Replace(strPasta.Path, "'", "''") & "\" & strFicheiro.Name & "'"

Ivan;

Para a mensagem que você deseja, vamos fazer uma coisa engraçada fora da função:

No seu botão do formulario, que chama a função;

Código:

Private Sub SeuBotão_Click()
Dim intTotalRegistrosInicial As Variant
Dim intTotalRegistrosFinal As Variant
Dim intTotal As Variant
'Inicia as variaveis com zero
intTotalRegistrosInicial = 0
intTotalRegistrosFinal = 0
intTotal = 0
'insere o total inicial na 1ª variavel
intTotalRegistrosInicial = DCount("*", "SuaTabela")
    Call ContaFicheirosExtraiNome("C:\Pasta1\", True)
'insere o total final na 2ª variavel
intTotalRegistrosFinal = DCount("*", "SuaTabela")
'insere na variavel total a diferença das outras duas
intTotal = intTotalRegistrosFinal - intTotalRegistrosInicial
'se a variavel inicial for menor que a final, dá mensagem de quantos registros tiveram sucesso
    If intTotalRegistrosInicial < intTotalRegistrosFinal Then
        MsgBox "Inseridos " & intTotal & " registros com sucesso...", vbInformation
        Else
'senão o código morre aqui
        Exit Sub
    End If
End Sub


Perfeito.

Mestríssimo, boa tarde.

Matou a pau.

Funfou de forma esplêndida, consegui importar todos os ficheiros numa tacada só e depois na Pesquisa abriu a imagem correta.
Exemplo:

Na Pasta Original = Álvaro Roque de Sant'Ana

Na Tabela = Álvaro Roque de Sant 'Anna

A pesquisa bateu em cima e exibiu a imagem de Álvaro Roque de Sant'Ana

Fico até emocionado Cara!!!

Abração, WSenna  

PS. Estou utilizando o X360 Multi-page Tiff Viewer ActiveX OCX o Amigo conhece?
Se não, tem alguma sugestão?

Bom dia velho amigo;

Fico feliz por ter funfado como esperava.

Quanto à sua pergunta, eu não conheço não essa OCX e nunca testei nada com .tif, mas sei que o access abre sem problemas ficheiros .tif

Call Shell("C:\Program Files\Microsoft Office\OFFICE12\OIS.EXE " & Chr(34) & "C:\Pasta1\teste.tif" & Chr(34), vbMaximizedFocus)

Grande JPaulo, bom dia.

Amigão, segui seu conselho.
Apenas não encontrei o IOS.exe então substitui por:

Call Shell("C:\WINDOWS\WANGIMG.EXE " & Chr(34) & Me.caminho & Chr(34), vbMaximizedFocus)

e funfou direto.

Abraços e um beijão em vosso coração.

WSenna

Obrigado pelo retorno o forum agradece.

Nota:
O IOS.exe é nativo do Windows, é o Microsoft Office Picture Manager.

Muito bom!!!

Estou precisando listar todos os documentos de uma determinada pasta que fica em vários caminhos diferentes, "ARTEC/DR", mas sempre terá este nome.

Exemplo:

Sempre vai existir o caminho "\ARTEC\DOC_REFERENCIA" nos diversos diretórios do servidor. Gostaria de Ler apenas quando fosse esta pasta.

Como ficaria?

Parabéns pelo fórum e obrigado desde já