Macro em Excel (VBA) para localizar arquivos por nome ou extensão em uma rede

[dreansb]

Olá amigos,

preciso saber se existe a possibilidade de se fazer uma macro em Excel onde, em uma célula (que seria uma variável) eu colocasse o tipo de arquivo (extensão - ex. pdf, xls, txt, etc.) (seria necessário também que tivesse a possibilidade de pesquisar pelo nome do arquivo ou parte dele também, e ele pesquisasse (na rede) em 5 endereços distintos (estes endereços estariam em outras células (variáveis). Como resultado ele me listaria todos os arquivos e seus respectivos endereços.

Deu pra entender?

seria quase a mesma coisa que pesquisar pelos recursos do Windows porém com a vantagem de esta pesquisa ser feita em até 5 pastas (ou endereços distintos).

Tenho a seguinte macro que lista todos os arquivos de uma determinada pasta

mas não é bem isso que preciso:

_________________________________

Private Sub Worksheet_Activate()

Dim Caminho As String

Caminho = Range("e1") 'célula (variável) onde coloco o endereço a ser pesquisado

ListarArquivos Caminho, Me.Name

End Sub

_________________________________

Private Sub ListarArquivos(Caminho As String, Planilha As String)

Dim FSO As Object, Pasta As Object, Arquivo As Object, Arquivos As Object

Dim Linha As Long

Set FSO = CreateObject("Scripting.FileSystemObject")

If Not FSO.FolderExists(Caminho) Then

MsgBox "A pasta '" & Caminho & "' não existe.", vbCritical, "Erro"

Exit Sub

End If

Set Pasta = FSO.GetFolder(Caminho)

Set Arquivos = Pasta.Files

For Each Arquivo In Arquivos

Linha = Linha + 1

Me.Cells(Linha + 2, 1) = UCase$(Arquivo.Path)

Me.Cells(Linha + 2, 2) = Format$((Arquivo.Size / 1024), "#,##0") & " KB"

Me.Cells(Linha + 2, 3) = Format$(Arquivo.Type)

Me.Cells(Linha + 2, 4) = Format$(Arquivo.Name)

Next

End sub

______________________________

[dreansb]

...e aí galera.

consegui alguma coisa na internet e fiz algumas adaptações (este código lista todos os arquivos do diretório (importante: faz uma varredura de todas pastas e sub-pastas) informado na célula E1, que tenham o nome informado na célula C1e cuja extensão consta na célula D1 - pode-se usar "*" como coringa, tanto no nome do arquivo quanto na sua extensão) segue o cód.:

Sub FileSearchByHavrda_teste()

Dim FileNameWithPath As Variant

Dim ListOfFilenamesWithParh As New Collection

Dim r As Long

Dim n As String

Dim e As String

Dim f As String

n = Range("C1").Value

e = Range("D1").Value

f = Range("E1").Value

Range("B2").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.ClearContents

' Filling a collection of filenames (search Excel files including subdirectories)

Call FileSearchByHavrda(ListOfFilenamesWithParh, f, n & "." & e, True)

For Each FileNameWithPath In ListOfFilenamesWithParh ' cycle for list(collection) processing

Debug.Print FileNameWithPath & Chr(13)

r = Range("B65536").End(xlUp).Row + 1

Cells(r, 2).Formula = FileNameWithPath & Chr(13)

Next FileNameWithPath

If ListOfFilenamesWithParh.Count = 0 Then

Debug.Print "No file was found !"

MsgBox "No file was found !"

Else

Range("a1").Value = ListOfFilenamesWithParh.Count

End If

Range("B2").Select

Range(Selection, Selection.End(xlDown)).Select

End Sub

------------------------------------------------------------------------------------------------

Private Sub FileSearchByHavrda(pFoundFiles As Collection, pPath As String, pMask As String, pIncludeSubdirectories As Boolean)

Dim DirFile As String

Dim CollectionItem As Variant

Dim SubDirCollection As New Collection

pPath = Trim(pPath)

If Right(pPath, 1) <> "\" Then pPath = pPath & "\"

DirFile = Dir(pPath & pMask)

Do While DirFile <> ""

pFoundFiles.Add pPath & DirFile

DirFile = Dir ' next file

Loop

' Procedure exiting if searching in subdirectories isn't enabled

If Not pIncludeSubdirectories Then Exit Sub

' Searching for subdirectories in path

DirFile = Dir(pPath & "*", vbDirectory)

Do While DirFile <> ""

' Add subdirectory to local list(collection) of subdirectories in path

If DirFile <> "." And DirFile <> ".." Then If ((GetAttr(pPath & DirFile) And vbDirectory) = 16) Then SubDirCollection.Add pPath & DirFile

DirFile = Dir 'next file

Loop

' Subdirectories list(collection) processing

For Each CollectionItem In SubDirCollection

Call FileSearchByHavrda(pFoundFiles, CStr(CollectionItem), pMask, pIncludeSubdirectories) ' Recursive procedure call

Next

End Sub

[Piratah]

Ola!

Sou iniciante do clube, mas ja faz um tempão que estou pelejando para descobrir uma rotina/código que varreçe a pasta "matriz" e suas respectivas subpastas.

Tenho um projeto userform, formulário nele tenho os objetos:

1 Caixa de listagem, listbox

2 Caixas de texto, textbox

1 Botão de comando, CommandButton1

A ideia é;

Informar em uma caixa de texto, o caminho, já fiz isso beleza! coloquei a pasta "matriz".

Na outra informar o que vou pesquisar, meio termo, ou coringa "*formulário"

Dentro do botão tenho uma rotina/código, quando clico no mesmo ele pesquisa a pasta matriz, mas não lista suas subpastas, e me lista na caixa de listagem.

quando eu clico duas vezes em um dos nome que a pesquisa me listou, o arquivo "xls" abre, fiz isso Ok

Mas estou com um problemão o meu código só lista a arquivos da pasta "matriz" das subpasta não.

Alguem pode me ajudar, nessa força tarefa

estou ha exatos 10 meses tentando...

desde-ja agradeço.