List files in directory 4

[VBAva]

Hello all

i was wondering if there is a way to list all the files in a folder into an excel spread sheet using VBA?

what i would like to do is get all the filenames into a spreadsheet (one column) before having to do some editing on the files

i have not really worked with external files before so am not too sure where to start.

any help of suggestions would be great

thanks

 

[Chattin]

A couple of macros to play with here

Sub ListFiles()
'Before you run these macros, open a new worksheet and select the cell of the range _
into which you want the file names to be placed. To list different file types, you must _
modify the sample macros by changing the argument in the Dir() function. _
To return all Microsoft Excel add-in macros, replace "*.XLS" with "*.XLA," and so on. _
The specified directory can be any valid directory. To search a different folder, change _
<ExcelFiles> to the folder containing your Excel workbook files.

F = Dir(&quot;\\gb-chw-cent\chattin_c$\Spreadsheets\xl2k\*.*&quot ' C:\<ExcelFiles>\*.XLS
Do While Len(F) > 0
ActiveCell.formula = F
ActiveCell.Offset(1, 0).Select 'By Columns
'ActiveCell.Offset(0, 1).Select 'By Rows
F = Dir()
Loop
End Sub

Sub FileList()
Dim i As Long
With Application.FileSearch
.NewSearch
' *** Change Folder name to suit ***
.LookIn = InputBox(&quot;Enter the path to search&quot '&quot;C:\My Documents&quot;
.SearchSubFolders = True
'.Filename = &quot;*.*&quot;
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Cells(i, 1).Value = .FoundFiles(i)
Next i
End If
End With
End Sub

HTH

Chris ;-)

Visit

http://www.mrexcel.com/board/index.php

for great xl and xl/VBA help

 

[SgtPepps]

Hello

Chattin, i've found you second example very functional within a VBA procedure of mine. It wasn't until i started testing that i realised the code missed a fair amount of files, also, it somehow managed to list files with paths on completely differant drives. i.e. I Specify to list files on D:\Dir\ and it finds files on C:\Documents & Settings\etc.....

I've begun to look into creating my own code for this, due to the fact that i'm un-comfortable not knowing how my own procedures work. However, if you could help me by explaining your examples a little more, i may be able to understand and modify it to suit me.

Thank You Very Much

Mike

Hold the Wheel and drive

 

[xlbo]

This may be a bit easier to understand although it doesn't make use of the scripting runtime library so the functionality (if you needed it) will be reduced - ie can't get file properties etc but works just fine for the names:

filename = Dir$(&quot;\\Devon\Shared\Plans\*.tif&quot
'Start File Search
Sheets(&quot;Files&quot.Select
Range(&quot;A2&quot.Activate
Do While filename <> &quot;&quot;
ActiveCell.Offset(r, 0) = filename
r = r + 1
filename = Dir$()
Loop

Rgds, Geoff
[blue]Si hoc signum legere potes, operis boni in rebus Latinus alacribus et fructuosis potiri potes![/blue]
Want the [red]best[/red] answers to your questions ? faq222-2244

 

[SgtPepps]

Works well Geoff, thanks. My problem is that i based some other code around the list generated by Chattins second example. His code searches sub-folders and also it lists the file name with its full path. I'm trying to come up with a loop using your example and code that finds all folders in a folder. Its going OK so-far but if you have a suggestion i'd be VERY happy to see it.

Thank You again

Mike

Hold the Wheel and drive

 

[xlbo]

Ok - here's a version using scripting runtime but I don't know that much about it so I havn't strayed away from what I know - this will list all files in the main folder and the subfolders 1 level down with the folder names

Sub ListAllFiles()
Dim fso, fldr, subFldr, oFiles, oFile
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fldr = fso.GetFolder("C:\Home\Exceldocs\")
    r = 1
    'Get Files in main folder
    For Each oFile In fldr.Files
        Cells(r, 1).Value = oFile.Path & "\" & oFile.Name
        Cells(r, 2).Value = fldr.Name
        r = r + 1
    Next
    'Get Files in subfolders
    For Each subFldr In fldr.SubFolders
        Set oFiles = subFldr.Files
        For Each oFile In oFiles
            Cells(r, 1).Value = oFile.Path & "\" & oFile.Name
            Cells(r, 2).Value = subFldr.Name
            r = r + 1
        Next
    Next
    Set oFiles = Nothing
    Set subFldr = Nothing
    Set fldr = Nothing
    Set fso = Nothing
End Sub

Rgds, Geoff
[blue]Si hoc signum legere potes, operis boni in rebus Latinus alacribus et fructuosis potiri potes![/blue]
Want the [red]best[/red] answers to your questions ? faq222-2244

 

[SgtPepps]

I'll try it out later and let you know.

Thank You Very Much!

p.s. I feel the need to point out that i do TRY to learn these things myself, but when i scoped this project i must have missed out a lot. Live and Learn, and all that.

Regards

Mike

 

[VBAnewguy]

Hey folks, I have used this code and it works great, anyone know if there is a way to have the macro pull the subfolders within the subfolders (2 levels in)??

I have tried playing with the code, but can't seem to get it to do it, any help would be great!

Thanks,

 

[TonyJollans]

Hi VBAnewguy,

If you just want to go down another level and no more, all you need to do is add another loop inside the subfolder loop ..

[blue]Sub ListAllFiles()
Dim fso, fldr, subFldr, oFiles, oFile[red],subsubFldr[/red]
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fldr = fso.GetFolder("C:\Home\Exceldocs\")
    r = 1
    'Get Files in main folder
    For Each oFile In fldr.Files
        Cells(r, 1).Value = oFile.Path & "\" & oFile.Name
        Cells(r, 2).Value = fldr.Name
        r = r + 1
    Next
    'Get Files in subfolders
    For Each subFldr In fldr.SubFolders
        Set oFiles = subFldr.Files
        For Each oFile In oFiles
            Cells(r, 1).Value = oFile.Path & "\" & oFile.Name
            Cells(r, 2).Value = subFldr.Name
            r = r + 1
        Next
[red]
        'Get Files in sub-subfolders
        For Each subsubFldr In subFldr.SubFolders
            Set oFiles = subsubFldr.Files
            For Each oFile In oFiles
                Cells(r, 1).Value = oFile.Path & "\" & oFile.Name
                Cells(r, 2).Value = subFldr.Name
                r = r + 1
            Next
            
        Next
[/red]
    Next
    Set oFiles = Nothing
    Set subFldr = Nothing
    Set fldr = Nothing
    Set fso = Nothing
End Sub[/blue]

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

 

[CajunCenturion]

That of course begs the question, what if I want to go 3 levels deep, or 4, or 5, or take me as deep as the directory structure is. To do that will require a recursive process, and the following example will populate a Collection with all of the Excel files from the "c:\Reference" subdirectory on down. Like some of the example above, it requires the FileSystemObject

Private Sub cmdGetFiles_Click()
   
   WalkDirTree "C:\Reference", ".xls"

End Sub

Private Sub WalkDirTree(TopDir As String, FileExt As String)
    
   Dim FSO As FileSystemObject
   Dim FileList As New Collection
   Dim Idx As Integer
   
   Set FSO = CreateObject("Scripting.FileSystemObject")
   ProcessFolder FSO.GetFolder(TopDir), FileList, FileExt
   Set FSO = Nothing
   
[COLOR=green]' Here is where you process all of the found files[/color]

   If (FileList.Count > 0) Then
      For Idx = 1 To FileList.Count
         MsgBox "Process File:  " & FileList.Item(Idx)
      Next Idx
   Else
      MsgBox "No Files Found"
   End If
   
End Sub

Private Sub ProcessFolder(FolderName As Scripting.Folder, FileList As Collection, FileExt As String)

   Dim SubFolders As Scripting.Folders
   Dim FileNames As Scripting.Files
   Dim SubFolderName As Scripting.Folder
   Dim FileID As Scripting.File
   
   Set SubFolders = FolderName.SubFolders
   For Each SubFolderName In SubFolders
      ProcessFolder SubFolderName, FileList, FileExt
   Next
   
   Set FileNames = FolderName.Files
   For Each FileID In FileNames
      If (UCase(Right(FileID.Path, Len(FileExt))) = UCase(FileExt)) Then
         FileList.Add FileID.Path
      End If
   Next
   
   Set FileID = Nothing
   Set SubFolderName = Nothing
   Set FileNames = Nothing
   Set SubFolders = Nothing
   
End Sub

Good Luck
--------------
As a circle of light increases so does the circumference of darkness around it. - Albert Einstein

 

[Kathleen422]

You might want to try this link. Its really great, just like the old days of DOS. Gives you a browse button and all. I use it all the time.

http://www.tushar-mehta.com/

 

[MCubitt]

Did anyone actually get Cajun's script to work? I got all kinds of errors relating to user-defined type not allowed and such.
I'm using Excel 2000 and Windows 2000.

Someone must (surely!) have a routine to obtain a list of files that match a pattern (eg XLS) recursively from a selected start point?

Thanks





Applications Support
UK

 

[xlbo]

Works fine for me - you must set a reference to MS Scripting Runtime in the VBE and it will probably help to change the msgbox to write to the spreadsheet rather than just pop up the name of the files

Nice code by the way Cajun !

Rgds, Geoff

"Having been erased. the document thjat you are seeking. Must now be retyped"

Please read FAQ222-2244 before you ask a question

 

[MCubitt]

xlbo,

Thanks for confirming, please advise how to implement the "MS Scripting Runtime".

Thanks


Applications Support
UK

 

[PHV]

how to implement the "MS Scripting Runtime"
While in VBE, menu Tools -> References ...

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[MCubitt]

Thank you all, this works well.

However, I was thinking, has anyone written a pattern matching routine to mimic the file selection pattern matching.

Ie if fileext is replaces by filepattern which could have the value 'M*.Log' all files starting with M and with the Log extension are found.

Rather than re-invent the wheel, has anyone done this already?

Thanks



Applications Support
UK

 

[MCubitt]

Well, I think I did it!

This example looks for files where the name ends with 90 and the extension can be anything.

By no means thoroughly tested mind you so please feel free to de-flaw.

Private Sub Generate_Click()
   WalkDirTree "\\ifsprint\zfax\USERS\ADMINIST\Z-OUT", "*90", "*"
   MsgBox (FileList)
End Sub


Private Sub WalkDirTree(TopDir As String, FilePattern As String, FileExt As String)
    
   Dim FSO As FileSystemObject
   Dim FileList As New Collection
   Dim Idx As Integer
   
   Set FSO = CreateObject("Scripting.FileSystemObject")
   ProcessFolder FSO.GetFolder(TopDir), FileList, FilePattern, FileExt
   Set FSO = Nothing
   
' Here is where you process all of the found files

   If (FileList.Count > 0) Then
      For Idx = 1 To FileList.Count
         MsgBox "Process File:  " & FileList.Item(Idx)
      Next Idx
   Else
      MsgBox "No Files Found"
   End If
   
End Sub

Private Sub ProcessFolder(FolderName As Scripting.Folder, FileList As Collection, FilePattern As String, FileExt As String)

   Dim SubFolders As Scripting.Folders
   Dim FileNames As Scripting.Files
   Dim SubFolderName As Scripting.Folder
   Dim FileID As Scripting.File
   
   Set SubFolders = FolderName.SubFolders
   For Each SubFolderName In SubFolders
      ProcessFolder SubFolderName, FileList, FilePattern, FileExt
   Next
   
   Set FileNames = FolderName.Files
   For Each FileID In FileNames
      dot = InStr(FileID.Path, ".")
      filebeforedotwithslash = UCase(Left(FileID.Path, dot - 1))
      slash = InStrRev(filebeforedotwithslash, "\")
      filebeforedot = Right(filebeforedotwithslash, Len(filebeforedotwithslash) - slash)
      fileafterdot = UCase(Right(FileID.Path, Len(FileID.Path) - dot))
'      If (UCase(Right(FileID.Path, Len(FileExt))) = UCase(FileExt)) Then
      If (filebeforedot Like UCase(FilePattern) And fileafterdot Like UCase(FileExt)) Then
         FileList.Add FileID.Path
      End If
   Next
   
   Set FileID = Nothing
   Set SubFolderName = Nothing
   Set FileNames = Nothing
   Set SubFolders = Nothing  
End Sub

Applications Support
UK