VB6 - BOTAO UPLOAD / CARREGAR FICHEIRO

Dim fso As FileSystemObject
Set fso = New FileSystemObject

Dim ListaC   As Collection
Set ListaC = New Collection

Dim RooT    As Folder
Dim SubRooT As Folder
Dim lArquivo   As File
Dim Filtro  As String

Filtro = [Ô]txt,vbp,bmp[Ô] [ô] Aqui você define as extensões a serem procuradas, só separe elas por vírgula para não
[ô]ocorrer nenhum problema de uma juntar na outra e formar uma nova extensão por ex [Ô]vbpbmp[Ô] ficaria [Ô]vbp,bmp[Ô].

ListaC.Add [Ô]C:\Projeto[Ô]  [ô] Aqui você define onde começar a procurar
                                      [ô] E como eu disse, para diretórios com MUITOS subdiretórios talvez ele leve um tempo
                                      [ô] Mas se não se assuste, se necessário descomente o DoEvent que está em cima do Loop

Do While ListaC.Count > 0
Set RooT = fso.GetFolder(ListaC(1))
For Each lArquivo In RooT.Files

If InStr(1, LCase(Filtro), LCase(Right(lArquivo.Name, 3)), vbTextCompare) Then
[ô] Aqui você pode fazer tudo o quê quiser quando um arquivo for encontrado (:
List1.AddItem lArquivo.Name
[ô] -----------------------------------------------------------------------
End If

Next

For Each SubRooT In RooT.SubFolders
ListaC.Add SubRooT.Path
Next


ListaC.Remove 1
[ô]DoEvents
Loop 

Citação:

:
Pra procurar em subpastas, eu tenho um código aqui que fiz há um tempinho atrás...
Só que para MUITAS pastas e arquivos ( Como o disco C: ) ele leva um tempinho pois ele dá um loop pega as pastas, adiciona numa lista, abre pasta por pasta da mais um loop e se achar mais pastas adiciona na lista e assim vai..

Dim fso As FileSystemObject
Set fso = New FileSystemObject

Dim ListaC   As Collection
Set ListaC = New Collection

Dim RooT    As Folder
Dim SubRooT As Folder
Dim lArquivo   As File
Dim Filtro  As String

Filtro = [Ô]txt,vbp,bmp[Ô] [ô] Aqui você define as extensões a serem procuradas, só separe elas por vírgula para não
[ô]ocorrer nenhum problema de uma juntar na outra e formar uma nova extensão por ex [Ô]vbpbmp[Ô] ficaria [Ô]vbp,bmp[Ô].

ListaC.Add [Ô]C:Projeto[Ô]  [ô] Aqui você define onde começar a procurar
                                      [ô] E como eu disse, para diretórios com MUITOS subdiretórios talvez ele leve um tempo
                                      [ô] Mas se não se assuste, se necessário descomente o DoEvent que está em cima do Loop

Do While ListaC.Count > 0
Set RooT = fso.GetFolder(ListaC(1))
For Each lArquivo In RooT.Files

If InStr(1, LCase(Filtro), LCase(Right(lArquivo.Name, 3)), vbTextCompare) Then
[ô] Aqui você pode fazer tudo o quê quiser quando um arquivo for encontrado (:
List1.AddItem lArquivo.Name
[ô] -----------------------------------------------------------------------
End If

Next

For Each SubRooT In RooT.SubFolders
ListaC.Add SubRooT.Path
Next


ListaC.Remove 1
[ô]DoEvents
Loop