buscar

hola juan.

Informarte que el codigo funciona a las mil maravillas. Realmente busca los
archivos incluyendo las subcarpetas, informarte tambien de que he encontrado
un error en tu codigo, que es que a lar hora de buscar, si no encuentra el
archivo o archivos especificados, falla el programita. Pero bueno, eso ya lo
he solucionado facilmente.

Gracias juan

"Juan" wrote:

Hola juanjo

prueba el siguiente codigo
fijate en los comentarios para cambiar lo que necesites

un saludo
juan

= en un modulo estandar

Dim nombre As String

Function CreateFileList(FileFilter As String, _
IncludeSubFolder As Boolean) As Variant
Dim FileList() As String, FileCount As Long

nombre = "c:uta\" 'aqui pones tu ruta importa la barra \
CreateFileList = ""
Erase FileList
If FileFilter = "" Then FileFilter = "*.*" ' all files
With Application.FileSearch
.NewSearch
.LookIn = nombre
.Filename = FileFilter
.SearchSubFolders = False 'aqui te incluye las sub carpetas
cambia a true
.FileType = msoFileTypeAllFiles
If .Execute(SortBy:=msoSortByFileName,
SortOrder:=msoSortOrderAscending) = 0 Then Exit Function
ReDim FileList(.FoundFiles.Count)
For FileCount = 1 To .FoundFiles.Count
FileList(FileCount) = .FoundFiles(FileCount)
Next FileCount
.FileType = msoFileTypeExcelWorkbooks
End With
CreateFileList = FileList
Erase FileList
End Function

Sub GeneraLista()
Dim FileNamesList As Variant, i As Integer, j As Integer

j = 0
FileNamesList = CreateFileList("*.LCK", False) 'aqui cambia la extension
Range("A:A").ClearContents
For i = 1 To UBound(FileNamesList)
Cells(i + 1, 1).Formula = Right(FileNamesList(i),
Len(FileNamesList(i)) - Len(nombre))
j = j + 1
Next i
Cells(1, 1) = j
End Sub

"Juanjo" escribió en el mensaje
news:
> Hola de nuevo.
>
> Necesito buscar mediante codigo VBA todos los archivos *.LCK, el caso es
> que
> no se como crear el codigo a la hora de hacer que busque en las
> subcarpetas
> del las carpetas y a su vez en cada subcarpeta de estas.
>
> Gracias

Hola juanjo

el codigo no es mio, viene de esta direccion, solo lo modifique un poco (lo
de la extension y poco mas)

http://www.erlandsendata.no/english...infolder97

lo mismo encuentras alguna otra cosa mas que te sea de utilidad

un saludo
juan

"Juanjo" escribió en el mensaje
news:

hola juan.

Informarte que el codigo funciona a las mil maravillas. Realmente busca
los
archivos incluyendo las subcarpetas, informarte tambien de que he
encontrado
un error en tu codigo, que es que a lar hora de buscar, si no encuentra el
archivo o archivos especificados, falla el programita. Pero bueno, eso ya
lo
he solucionado facilmente.

Gracias juan

"Juan" wrote:

Hola juanjo

prueba el siguiente codigo
fijate en los comentarios para cambiar lo que necesites

un saludo
juan

= en un modulo estandar

Dim nombre As String

Function CreateFileList(FileFilter As String, _
IncludeSubFolder As Boolean) As Variant
Dim FileList() As String, FileCount As Long

nombre = "c:uta\" 'aqui pones tu ruta importa la barra \
CreateFileList = ""
Erase FileList
If FileFilter = "" Then FileFilter = "*.*" ' all files
With Application.FileSearch
.NewSearch
.LookIn = nombre
.Filename = FileFilter
.SearchSubFolders = False 'aqui te incluye las sub carpetas
cambia a true
.FileType = msoFileTypeAllFiles
If .Execute(SortBy:=msoSortByFileName,
SortOrder:=msoSortOrderAscending) = 0 Then Exit Function
ReDim FileList(.FoundFiles.Count)
For FileCount = 1 To .FoundFiles.Count
FileList(FileCount) = .FoundFiles(FileCount)
Next FileCount
.FileType = msoFileTypeExcelWorkbooks
End With
CreateFileList = FileList
Erase FileList
End Function

Sub GeneraLista()
Dim FileNamesList As Variant, i As Integer, j As Integer

j = 0
FileNamesList = CreateFileList("*.LCK", False) 'aqui cambia la
extension
Range("A:A").ClearContents
For i = 1 To UBound(FileNamesList)
Cells(i + 1, 1).Formula = Right(FileNamesList(i),
Len(FileNamesList(i)) - Len(nombre))
j = j + 1
Next i
Cells(1, 1) = j
End Sub

"Juanjo" escribió en el mensaje
news:
> Hola de nuevo.
>
> Necesito buscar mediante codigo VBA todos los archivos *.LCK, el caso
> es
> que
> no se como crear el codigo a la hora de hacer que busque en las
> subcarpetas
> del las carpetas y a su vez en cada subcarpeta de estas.
>
> Gracias