Load file names in a folder and subfolders.

MelG

New Member
Joined
Jul 28, 2011
Messages
21
Hi,

I've mixed and matched the code below to allow the user to browse and select a file in any folder. The macro then loads the filename of all files contained in that folder.

The code does not however load file names in the subfolders. Could the formula be amended to include subfolders. Idealy I want the user to select any folder (not a file in any folder) and it will load all the filenames contained in that folder and subfolders. If this was displayed so file path was returned in column A and file names in column B, this would be even better.

*****************************************************

Private Sub Submit_Click()
Dim dlgOpen As FileDialog
Dim vrtSelectedItem As Variant
Dim wsPending As Worksheet
Dim strFile As String
Dim i As Integer
Sheets.Add
ActiveSheet.Name = "Pending"
Set wsPending = Application.ActiveSheet
Set dlgOpen = Application.FileDialog(FileDialogType:=msoFileDialogOpen)
MsgBox "Select any file from the Pending folder"
With dlgOpen
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
strFile = Dir("")
wsPending.Cells(4, 1) = strFile
i = 2
Do
strFile = Dir
wsPending.Cells(i + 3, 1) = strFile
i = i + 1
Loop Until "" = strFile
Next vrtSelectedItem
End If
End With
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,004
First, place the following code in a regular module (VBE > Insert > Module). Then, run the macro called "ListFiles". Note that the path and filenames will be listed in the active sheet.

Code:
[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Dim[/color] Cnt [color=darkblue]As[/color] [color=darkblue]Long[/color]

[color=darkblue]Sub[/color] ListFiles()

    [color=darkblue]Dim[/color] objFSO [color=darkblue]As[/color] FileSystemObject
    [color=darkblue]Dim[/color] MyPath [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] MyArray() [color=darkblue]As[/color] [color=darkblue]String[/color]
    
    Cnt = 0
    
    [color=darkblue]Set[/color] objFSO = CreateObject("Scripting.FileSystemObject")
    
    [color=darkblue]With[/color] Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Select a Folder"
        .Show
        [color=darkblue]If[/color] .SelectedItems.Count > 0 [color=darkblue]Then[/color]
            MyPath = .SelectedItems(1)
            [color=darkblue]Call[/color] ProcessFolders(objFSO, MyPath, MyArray)
        [color=darkblue]Else[/color]
            [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    Cells.Clear
    [color=darkblue]If[/color] Cnt > 0 [color=darkblue]Then[/color]
        Range("A1:B1").Value = Array("File Path", "File Name")
        Range("A2").Resize(UBound(MyArray, 2), UBound(MyArray, 1)).Value = WorksheetFunction.Transpose(MyArray)
    [color=darkblue]Else[/color]
        MsgBox "No files were found...", vbExclamation
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]


Sub ProcessFolders([color=darkblue]ByRef[/color] f, [color=darkblue]ByVal[/color] p, [color=darkblue]ByRef[/color] arr)
    [color=darkblue]Dim[/color] objFolder [color=darkblue]As[/color] Folder
    [color=darkblue]Dim[/color] objSubFolder [color=darkblue]As[/color] Folder
    [color=darkblue]Dim[/color] objFile [color=darkblue]As[/color] File
    [color=darkblue]Set[/color] objFolder = f.GetFolder(p)
    [color=darkblue]For[/color] [color=darkblue]Each[/color] objFile [color=darkblue]In[/color] objFolder.Files
        Cnt = Cnt + 1
        [color=darkblue]ReDim[/color] [color=darkblue]Preserve[/color] arr(1 [color=darkblue]To[/color] 2, 1 To Cnt)
        arr(1, Cnt) = objFolder.Path
        arr(2, Cnt) = objFile.Name
    [color=darkblue]Next[/color] objFile
    [color=darkblue]For[/color] [color=darkblue]Each[/color] objSubFolder [color=darkblue]In[/color] objFolder.SubFolders
        [color=darkblue]Call[/color] ProcessFolders(f, obj[color=darkblue]Sub[/color]Folder, arr)
    [color=darkblue]Next[/color] objSubFolder
[color=darkblue]End[/color] Sub
[/font]
 

MelG

New Member
Joined
Jul 28, 2011
Messages
21
Hi Domenic,

Thanks for the code. I've copied the code into a new module and I get an error message that says "user defined typer not defined" and highlights objFSO As FileSystemObject. I'm using excel 2003 if that has anything to do with it.
 

fucell

New Member
Joined
Jan 3, 2011
Messages
46
try this

activate the reference FileObjectLibrary

go to >Tools>reference>

then check the FileSystemBrowser type library


hope this helps.

;)
 

MelG

New Member
Joined
Jul 28, 2011
Messages
21
There's loads of other type libraries but I don't have a "FileSystemBrowser type library" to select. The only one's beginning with F are FName, FPTC, FPerdon, FPlace, FrameworkService, FSHook, FStock.
 

MelG

New Member
Joined
Jul 28, 2011
Messages
21
I've got it working now. Found a thread that said to browse for scrrun.dll to get the FileSystemBrowser working. Cheers all!
 

Forum statistics

Threads
1,081,706
Messages
5,360,769
Members
400,595
Latest member
T_Dubs

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top