DIR

Hola!

Hace un tiempo necesitaba algo similar y alguien amablemente me
proporciono este codigo que hace mas o menos lo que el DIR que
mencionas, espero te sirva.


Function CreateFileList(FileFilter As String, _
IncludeSubFolder As Boolean) As Variant
' returns the full filename for files matching
' the filter criteria in the current folder
Dim FileList() As String, FileCount As Long
CreateFileList = ""
Erase FileList
If FileFilter = "" Then FileFilter = "*.*" ' all files
With Application.FileSearch
.NewSearch
.LookIn = CurDir
.Filename = FileFilter
.SearchSubFolders = IncludeSubFolder
.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 ' reset filetypes
End With
CreateFileList = FileList
Erase FileList
End Function

Sub TestCreateFileList()
Dim FileNamesList As Variant, i As Integer
ChDir "aqui va la ruta"
' activate the desired startfolder for the filesearch
FileNamesList = CreateFileList("*.*", False)
' performs the filesearch, includes any subfolders
' present the result
Range("A:A").ClearContents
For i = 1 To UBound(FileNamesList)
Cells(i + 1, 1).Formula = FileNamesList(i)
Next i
End Sub

Hola gracias por responder.
Me funciono ok, modificandole la linea chdir.

Ahora te consulto, el resultado siempre lo ubica en la columna A, yo quiero
ubicarlo en la columna D, como lo hago ???

Gracias y saludos


"Murphy" escribió:

Hola!

Hace un tiempo necesitaba algo similar y alguien amablemente me
proporciono este codigo que hace mas o menos lo que el DIR que
mencionas, espero te sirva.


Function CreateFileList(FileFilter As String, _
IncludeSubFolder As Boolean) As Variant
' returns the full filename for files matching
' the filter criteria in the current folder
Dim FileList() As String, FileCount As Long
CreateFileList = ""
Erase FileList
If FileFilter = "" Then FileFilter = "*.*" ' all files
With Application.FileSearch
.NewSearch
.LookIn = CurDir
.Filename = FileFilter
.SearchSubFolders = IncludeSubFolder
.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 ' reset filetypes
End With
CreateFileList = FileList
Erase FileList
End Function

Sub TestCreateFileList()
Dim FileNamesList As Variant, i As Integer
ChDir "aqui va la ruta"
' activate the desired startfolder for the filesearch
FileNamesList = CreateFileList("*.*", False)
' performs the filesearch, includes any subfolders
' present the result
Range("A:A").ClearContents
For i = 1 To UBound(FileNamesList)
Cells(i + 1, 1).Formula = FileNamesList(i)
Next i
End Sub

hola, (...) ?

Me funciono ok, modificandole la linea chdir.
Ahora te consulto, el resultado siempre lo ubica en la columna A, yo quiero ubicarlo en la columna D, como lo hago ???

1) cambia las instrucciones finales del segundo procedimiento...

de:
Range("A:A").ClearContents
For i = 1 To UBound(FileNamesList)
Cells(i + 1, 1).Formula = FileNamesList(i)

a:
Range("d:d").ClearContents
For i = 1 To UBound(FileNamesList)
Cells(i + 1, 4).Formula = FileNamesList(i)

2) te sugiero que cambies a la funcion Dir() [solo por si las dudas, por lo siguiente]:
[hasta donde se]... un objeto 'FileSearch' pudiera ser ineficiente cuando se combinan 'ciertos factores'... [p.e.]
- la 'pareja' de versiones de office/excel 'con' windows [y las actualizaciones instaladas]
- como se pudiera 'combinar' el '.FileName' con el '.FileType' [y se se usan 'comodines' antes/despues del 'patron de busqueda']
- con 'ciertas combinaciones'... el metodo '.Execute(...)' -> NO devuelve nada :-\\

saludos,
hector.