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
