List Files

[Jaye7]

I found the following code on this forum, however can someone please modify a couple of things for me.

I would like the script to list the full file name and path i.e C:\Test\Help.xls, also I would like it to ask what folder you want to list the files from (i.e. popup box to select folder) and also a popup which asks you to specify file type, i.e. .jpg, .xls, .wma etc...

'Written: February 19, 2009 (Updated April 03, 2009)
'Author:  Leith Ross
'Summary: Creates a file list and copies it to the Active Sheet start at "A1".
'         The arguments are the directory to be searched, the file type (extension),
'         and optionally a wildcard filter for file names. Only the rquired argument
'         is the directory path.
Function CreateFileList(ByVal FolderPath As String, Optional ByVal FileType As String, Optional ByVal FileFilter As String) As Variant
  Dim Cnt As Long
  Dim FileList() As String
  Dim FileName As String
    On Error GoTo OutOfHere
 
    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
    If FileType = "" Then
       FileType = ".*"
    Else
       If Left(FileType, 1) <> "." Then FileType = "." & FileType
    End If
    If FileFilter = "" Then FileFilter = "*"
 
      FileName = Dir(FolderPath & FileFilter & FileType)
        Do While FileName <> ""
          Cnt = Cnt + 1
          ReDim Preserve FileList(Cnt)
          FileList(Cnt) = FileName
          FileName = Dir()
       Loop
 
OutOfHere:
     If Err = 0 Then CreateFileList = FileList
     On Error GoTo 0
 
End Function
Sub ListFiles()
  Dim I As Long
  Dim MyFiles As Variant
  Dim MyArray() As String
  Dim N As Long
  Dim Rng As Range
  Dim RngEnd As Range
 
    MyFiles = CreateFileList("C:\Test\", ".xls")
 
      N = UBound(MyFiles)
      ReDim MyArray(N, 0)
 
        For I = 1 To N
          MyArray(I, 0) = MyFiles(I)
        Next I
 
        Set Rng = Worksheets("Sheet2").Range("A2")
        Set Rng = Cells(Rows.Count, Rng.Column).End(xlUp)
        Set Rng = Rng.Resize(N + 1, 1)
 
        Rng = MyArray
 
End Sub

Thanks


.

 

[Jaye7]

Anyone?????

 

[AlphaFrog]

Sub ListFiles()
  Dim I As Long
  Dim MyFiles As Variant
  Dim MyArray() As String
  Dim N As Long
  Dim Rng As Range
  Dim RngEnd As Range
[COLOR="Blue"]  Dim strPath As String
  Dim Ext As String
  
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Select the folder and one file of the type you want listed"
        .InitialFileName = "*.*"
        .Show
        If .SelectedItems.Count Then
            strPath = .SelectedItems(1)
        Else: Exit Sub  ' user canceled
        End If
    End With
    
    Ext = Mid(strPath, InStrRev(strPath, "."))
    strPath = Left(strPath, InStrRev(strPath, Application.PathSeparator))[/COLOR]
    
    MyFiles = CreateFileList([COLOR="Blue"]strPath, Ext[/COLOR])
 
      N = UBound(MyFiles)
      ReDim MyArray(N, 0)
 
        For I = 1 To N
          MyArray(I, 0) = [COLOR="Blue"]strPath &[/COLOR] MyFiles(I)
        Next I
 
        Set Rng = Worksheets("Sheet2").Range("A2")
        Set Rng = Cells(Rows.Count, Rng.Column).End(xlUp)
        Set Rng = Rng.Resize(N + 1, 1)
 
        Rng = MyArray
 
End Sub

 

[Jaye7]

Thanks for the script but I get a compile error on the following line saying sub or function not defined.

MyFiles = CreateFileList(strPath, Ext)

 

[AlphaFrog]

Did you delete the Function CreateFileList? It was in your original code that you posted. You still need that part of the code.

The new code I posted only replaces the procedure Sub ListFiles() on down.

 

[Jaye7]

Sorry, I just copied your script to a separate module and tried it.

That's Perfect, works great, thanks Alphafrog.