Dir() function to return either List of files or folders

R

R Avery

I've created the following function to return a list of files given a
directory path. How would I modify it to return only folders? I have
tried to supply vbDirectory as an argument to the Dir function, but that
returns both folders and files. How do I make it return only folders?


Public Function GetFileListArray(ByVal Path As String, Optional ByVal
Filter As String = "*.*") As String()
Dim DirectoryFiles() As String
Dim strFileName As String

strFileName = Dir(Path & Filter)
Do While strFileName <> ""
If strFileName <> "" Then
ReDim Preserve DirectoryFiles(Count)
DirectoryFiles(Count) = strFileName
Count = Count + 1
End If
strFileName = Dir()
Loop

GetFileListArray = DirectoryFiles
End Function
 
J

John Green

Try the following version of your code:

Public Function GetFileListArray(ByVal Path As String, Optional ByVal Filter
As String = "*.*") As String()
Dim DirectoryFiles() As String
Dim strFileName As String
Dim Count As Long

strFileName = Dir(Path & Filter, vbDirectory)
Do While strFileName <> ""
If GetAttr(Path & strFileName) = vbDirectory Then
ReDim Preserve DirectoryFiles(Count)
DirectoryFiles(Count) = strFileName
Count = Count + 1
End If
strFileName = Dir()
Loop

GetFileListArray = DirectoryFiles
End Function


John Green
 
M

Myriam

I have been trying to create a function to do exactly what you say (return a list of files given a directory path).
I tried running your code but I got Compile error: type mismatch.
Would you please help me to create a macro to this exactly that: return a list of files given a directory path?
Thanks. I would really appreciate it!
 
I

Ian Ripsher

R Avery said:
I've created the following function to return a list of files given a
directory path. How would I modify it to return only folders? I have
tried to supply vbDirectory as an argument to the Dir function, but that
returns both folders and files. How do I make it return only folders?


Public Function GetFileListArray(ByVal Path As String, Optional ByVal
Filter As String = "*.*") As String()
Dim DirectoryFiles() As String
Dim strFileName As String

strFileName = Dir(Path & Filter)
Do While strFileName <> ""
If strFileName <> "" Then
ReDim Preserve DirectoryFiles(Count)
DirectoryFiles(Count) = strFileName
Count = Count + 1
End If
strFileName = Dir()
Loop

GetFileListArray = DirectoryFiles
End Function

I've tried both your code and John Green's for this function, and always get
#VALUE!. This is presumably because I'm using it in a workshet cell - can it
only be called from a Sub?
 
D

Dave Peterson

If you want to use it from a worksheet cell:

Option Explicit
Public Function GetFileListArray(ByVal Path As String, _
Optional ByVal Filter As String = "*.*") As Variant
Dim DirectoryFiles() As String
Dim strFileName As String
Dim CountOfFiles As Long

CountOfFiles = 0
strFileName = Dir(Path & Filter, vbDirectory)
Do While strFileName <> ""
If GetAttr(Path & strFileName) = vbDirectory Then
ReDim Preserve DirectoryFiles(CountOfFiles)
DirectoryFiles(CountOfFiles) = strFileName
CountOfFiles = CountOfFiles + 1
End If
strFileName = Dir()
Loop

If CountOfFiles = 0 _
Or CountOfFiles > (Application.Caller.Columns.Count _
* Application.Caller.Rows.Count) Then
GetFileListArray = CVErr(xlErrRef)
Else
If Application.Caller.Columns.Count = 1 Then
GetFileListArray = Application.Transpose(DirectoryFiles)
Else
GetFileListArray = DirectoryFiles
End If
End If

End Function

Select your range (single column or single row). Make sure it's big enough to
hold all the values you expect.

Then type your formula:
=GetFileListArray("C:\my documents\excel\")

Hit ctrl-shift-enter instead of enter. If you do it correctly, excel will wrap
curly brackets {} around your formula. (don't type them yourself.)

And Transpose is limited to 5461 elements in earlier versions of excel (before
xl2002).
 
I

Ian Ripsher

Dave Peterson said:
If you want to use it from a worksheet cell:

Option Explicit
Public Function GetFileListArray(ByVal Path As String, _
Optional ByVal Filter As String = "*.*") As Variant
Dim DirectoryFiles() As String
Dim strFileName As String
Dim CountOfFiles As Long

CountOfFiles = 0
strFileName = Dir(Path & Filter, vbDirectory)
Do While strFileName <> ""
If GetAttr(Path & strFileName) = vbDirectory Then
ReDim Preserve DirectoryFiles(CountOfFiles)
DirectoryFiles(CountOfFiles) = strFileName
CountOfFiles = CountOfFiles + 1
End If
strFileName = Dir()
Loop

If CountOfFiles = 0 _
Or CountOfFiles > (Application.Caller.Columns.Count _
* Application.Caller.Rows.Count) Then
GetFileListArray = CVErr(xlErrRef)
Else
If Application.Caller.Columns.Count = 1 Then
GetFileListArray = Application.Transpose(DirectoryFiles)
Else
GetFileListArray = DirectoryFiles
End If
End If

End Function

Select your range (single column or single row). Make sure it's big enough to
hold all the values you expect.

Then type your formula:
=GetFileListArray("C:\my documents\excel\")

Hit ctrl-shift-enter instead of enter. If you do it correctly, excel will wrap
curly brackets {} around your formula. (don't type them yourself.)

And Transpose is limited to 5461 elements in earlier versions of excel (before
xl2002).

Thanks. I thought it would have something to do with array functions (Ctrl
Shift Enter, etc).
 
M

Myriam

I tried it and I get #REF. I copied your code in Module 1
in Sheet 1, A1:A30 I copied your formula with Ctrl+Shift+Enter, the computer placed the {} The result was #REF.
What am I doing wrong?
Thanks!
 
M

Myrna Larson

Looking at this section of Dave's code,

If CountOfFiles = 0 _
Or CountOfFiles > (Application.Caller.Columns.Count _
* Application.Caller.Rows.Count) Then
GetFileListArray = CVErr(xlErrRef)


you will get a reference error if there are no directories or the number of
directories exceeds the number of cells you selected when you entered the
formula on the worksheet.

Note: you should select A1:A30, type the formula in A1, then press
CTRL+SHIFT+ENTER. You don't type it in A1 and copy it down, in case that's
what you did.


I tried it and I get #REF. I copied your code in Module 1
in Sheet 1, A1:A30 I copied your formula with Ctrl+Shift+Enter, the computer
placed the {} The result was #REF.
 
M

Myriam

Thanks. I now have folder names in the cells! I encountered 3 other problems:
1. The list is not in the same order as the directory
2. There is a dot (.) on the first cell and two dots (..) on the second cell
3. There is #N/A on the remaining cells (the extra space in the range)
What might be causing #1 and #2, I think I can fix #3.
And, what i need are the file names, not the subfolders, but I have not been able to make R Avery's first code work.
 
D

Dave Peterson

This worked ok for me. I added a sort and removed the directory only part.

Option Explicit
Public Function GetFileListArray(ByVal myPath As String, _
Optional ByVal Filter As String = "*.*") As Variant

Dim DirectoryFiles() As String
Dim strFileName As String
Dim CountOfFiles As Long
Dim CountOfCells As Long
Dim iCtr As Long
Dim jCtr As Long
Dim temp As String

'only one row or only one column
With Application.Caller
If .Columns.Count > 1 _
And .Rows.Count > 1 Then
GetFileListArray = CVErr(xlErrRef)
Exit Function
End If
CountOfCells = .Cells.Count
End With

If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

CountOfFiles = 0
strFileName = Dir(myPath & Filter)
Do While strFileName <> ""
If GetAttr(myPath & strFileName) = vbDirectory Then
'do nothing
Else
CountOfFiles = CountOfFiles + 1
ReDim Preserve DirectoryFiles(1 To CountOfFiles)
DirectoryFiles(CountOfFiles) = strFileName
End If
strFileName = Dir()
Loop

If CountOfFiles = 0 Then
GetFileListArray = CVErr(xlErrRef)
Else
For iCtr = LBound(DirectoryFiles) To UBound(DirectoryFiles) - 1
For jCtr = iCtr + 1 To UBound(DirectoryFiles)
If LCase(DirectoryFiles(iCtr)) > LCase(DirectoryFiles(jCtr)) _
Then
temp = DirectoryFiles(iCtr)
DirectoryFiles(iCtr) = DirectoryFiles(jCtr)
DirectoryFiles(jCtr) = temp
End If
Next jCtr
Next iCtr

ReDim Preserve DirectoryFiles(1 To CountOfCells)
For iCtr = CountOfFiles + 1 To UBound(DirectoryFiles)
DirectoryFiles(iCtr) = ""
Next iCtr

If Application.Caller.Columns.Count = 1 Then
GetFileListArray = Application.Transpose(DirectoryFiles)
Else
GetFileListArray = DirectoryFiles
End If
End If

End Function
 
M

Myriam

Thanks! It works PERFECT!

Dave Peterson said:
This worked ok for me. I added a sort and removed the directory only part.

Option Explicit
Public Function GetFileListArray(ByVal myPath As String, _
Optional ByVal Filter As String = "*.*") As Variant

Dim DirectoryFiles() As String
Dim strFileName As String
Dim CountOfFiles As Long
Dim CountOfCells As Long
Dim iCtr As Long
Dim jCtr As Long
Dim temp As String

'only one row or only one column
With Application.Caller
If .Columns.Count > 1 _
And .Rows.Count > 1 Then
GetFileListArray = CVErr(xlErrRef)
Exit Function
End If
CountOfCells = .Cells.Count
End With

If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

CountOfFiles = 0
strFileName = Dir(myPath & Filter)
Do While strFileName <> ""
If GetAttr(myPath & strFileName) = vbDirectory Then
'do nothing
Else
CountOfFiles = CountOfFiles + 1
ReDim Preserve DirectoryFiles(1 To CountOfFiles)
DirectoryFiles(CountOfFiles) = strFileName
End If
strFileName = Dir()
Loop

If CountOfFiles = 0 Then
GetFileListArray = CVErr(xlErrRef)
Else
For iCtr = LBound(DirectoryFiles) To UBound(DirectoryFiles) - 1
For jCtr = iCtr + 1 To UBound(DirectoryFiles)
If LCase(DirectoryFiles(iCtr)) > LCase(DirectoryFiles(jCtr)) _
Then
temp = DirectoryFiles(iCtr)
DirectoryFiles(iCtr) = DirectoryFiles(jCtr)
DirectoryFiles(jCtr) = temp
End If
Next jCtr
Next iCtr

ReDim Preserve DirectoryFiles(1 To CountOfCells)
For iCtr = CountOfFiles + 1 To UBound(DirectoryFiles)
DirectoryFiles(iCtr) = ""
Next iCtr

If Application.Caller.Columns.Count = 1 Then
GetFileListArray = Application.Transpose(DirectoryFiles)
Else
GetFileListArray = DirectoryFiles
End If
End If

End Function
 
D

Dave Peterson

One thing about this function is that it doesn't automatically update if you
delete/add files to that folder.

You could add:

application.volatile

Right at the top, but I would think that this would be overkill. (It tells
excel to reevaluate the function with each recalculation.) Just remember to
recalc whenever you think you should--well, that's the way I'd approach it.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top