[resolvido] listar pasta e subpastas

Moderador: Avelino Sampaio

rogeriod
Mensagens: 11
Registrado em: 09 Out 2018, 11:19

[resolvido] listar pasta e subpastas

Mensagempor rogeriod » 11 Out 2018, 20:36

boa tarde!

No código a seguir é possível listar os arquivos de uma pasta e das subpastas nela contida, porém, apenas os arquivos da pasta e subpasta, se houver outras pastas ramificadas não consegue. A questão é: seria possível código que lista-se todos os arquivos independentes de quantas subpastas ramificadas: obrigado

Código:
Option Compare Database
Option Explicit
Public xCam, xPasta As String
Public FileSystem As Object
Public Folder As Object
Public File As Variant
Public strCaminho As String

Function ListaArquivosESubPastas(ByVal path$) As String
On Error GoTo ProcErr
Dim Fsfd, Fd, Sfd, f1, Fls, Itn$
If path = "" Then Exit Function

'Este Set é para os arquivos
Set FileSystem = CreateObject("Scripting.FileSystemObject")

Set Folder = FileSystem.GetFolder(strCaminho)

For Each File In Folder.files

lstArquivos.AddItem File.Name

Next
'*****************
'até aqui

Set Fsfd = CreateObject("Scripting.FileSystemObject")
1 Set Fd = Fsfd.GetFolder(path$)
Do While Fd.path <> ".."
For Each Fls In Fd.files
'SysCmd acSysCmdSetStatus, Fd.path$ & "\" & Fls.name
Debug.Print Fd.path$ & "\" & Fls.Name
Next Fls
For Each Sfd In Fd.SubFolders
f1 = f1 + 1

Itn = Sfd.Name

'Original abaixo
'lstArquivos.AddItem f1 & " de " & Fd.SubFolders.Count & " ( " & Fd.path$ & "\" & Itn & " )"
'Debug.Print f1 & " de " & Fd.SubFolders.Count & " ( " & Fd.path$ & "\" & Itn & " )"
ListaArquivosESubPastas Fd.path$ & "\" & Itn & "\"

lstArquivos.AddItem Fd.path$ & "\" & Itn

'Pega os arquivos
Set Folder = FileSystem.GetFolder(Fd)
For Each File In Folder.files
lstArquivos.AddItem File.Name
Next

lstArquivos.Requery
Me.Requery
Next
GoSub Proc_Sai
Loop
Proc_Sai:
Set Fsfd = Nothing: Set Fd = Nothing: Set Sfd = Nothing: Set f1 = Nothing
Exit Function
ProcErr:
If Err = 76 Then Resume Proc_Sai
MsgBox Err & vbCr & Err.Description
Resume Next
End Function

Private Sub Comando8_Click()
Me.Requery
strCaminho = TxtCam.Value
Me.Requery
ListaArquivosESubPastas (strCaminho)
End Sub

Private Sub Form_Load()
TxtCam.SetFocus
End Sub

Private Sub lstArquivos_DblClick(Cancel As Integer)
Dim varItem As Variant
For Each varItem In lstArquivos.ItemsSelected
Dim strCaminho$
On Error GoTo 1
Application.FollowHyperlink xCam & Me.lstArquivos.Column(0)
1:
DoCmd.CancelEvent
Exit Sub
Next varItem
Me.lstArquivos.Requery
End Sub

Disable adblock

Precisamos do seu apoio. Faca uma doacao para o site atraves do Paypal.


Avatar do usuário
Damasceno Jr.
Mensagens: 409
Registrado em: 08 Jun 2015, 01:30
Localização: Medicilândia-Pará

Re: listar pasta e subpastas

Mensagempor Damasceno Jr. » 12 Out 2018, 01:02

Adapte ao seu cenário.

Obs.: cuidado quando dizes "independentes de quantas subpastas". Por exemplo: selecionar a raiz do Disco C: certamente faria o código passar horas varrendo tudo e travando até listar o resultado.
Você deve estar registrado e autenticado para ter acesso ao arquivo anexo.
Quanto mais o tempo passa, mais descubro e mais me apaixono por MS Access.

rogeriod
Mensagens: 11
Registrado em: 09 Out 2018, 11:19

Re: listar pasta e subpastas

Mensagempor rogeriod » 13 Out 2018, 10:54

obrigado, funciona perfeitamente para o que preciso.

Disable adblock

Precisamos do seu apoio. Faca uma doacao para o site atraves do Paypal.



Voltar para “Formulários”

Quem está online

Usuários neste fórum: Baidu [Spider] e 9 visitantes