Extract file names from folder

Is it possible for me to extract all of the files within a specific folder
into excel using vba?
Example: I would like to dump the name of each file located in the
follwoing path C:\My Documents\


Thanks in advance for any help that can be offered.

The free Excel add-in "List Files" will do that.
Download from ... http://www.realezsites.com/bus/primitivesoftware
No registration required.
--
Jim Cone
San Francisco, USA


"Haraki"
<[email protected]>
wrote in message
Is it possible for me to extract all of the files within a specific folder
into excel using vba?
Example: I would like to dump the name of each file located in the
follwoing path C:\My Documents\


Thanks in advance for any help that can be offered.

Option Explicit

Private cnt As Long
Private arfiles
Private level As Long

Sub Folders()
Dim i As Long
Dim sFolder As String
Dim iStart As Long
Dim iEnd As Long
Dim fOutline As Boolean

arfiles = Array()
cnt = -1
level = 1

sFolder = "E:\"
ReDim arfiles(2, 0)
If sFolder <> "" Then
SelectFiles sFolder
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Files").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Worksheets.Add.Name = "Files"
With ActiveSheet
For i = LBound(arfiles, 2) To UBound(arfiles, 2)
If arfiles(0, i) = "" Then
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If
With .Cells(i + 1, arfiles(2, i))
.Value = arfiles(1, i)
.Font.Bold = True
End With
iStart = i + 1
iEnd = iStart
fOutline = False
Else
.Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(2, i)), _
Address:=arfiles(0, i), _
TextToDisplay:=arfiles(1, i)
iEnd = iEnd + 1
fOutline = True
End If
Next
.Columns("A:Z").ColumnWidth = 5
End With
End If
'just in case there is another set to group
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If

Columns("A:Z").ColumnWidth = 5
ActiveSheet.Outline.ShowLevels RowLevels:=1
ActiveWindow.DisplayGridlines = False

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Static FSO As Object
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath

If FSO Is Nothing Then
Set FSO = CreateObject("Scripting.FileSystemObject")
End If

If sPath = "" Then
sPath = CurDir
End If

arPath = Split(sPath, "\")
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = ""
arfiles(1, cnt) = arPath(level - 1)
arfiles(2, cnt) = level

Set oFolder = FSO.GetFolder(sPath)
Set oFiles = oFolder.Files
For Each oFile In oFiles
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
arfiles(1, cnt) = oFile.Name
arfiles(2, cnt) = level + 1
Next oFile

level = level + 1
For Each oSubFolder In oFolder.Subfolders
SelectFiles oSubFolder.Path
Next
level = level - 1

End Sub

#If VBA6 Then
#Else
'-----------------------------**-----------------------------*-*------
Function Split(Text As String, _
Optional Delimiter As String = ",") As Variant
'-----------------------------**-----------------------------*-*------
Dim i As Long
Dim sFormula As String
Dim aryEval
Dim aryValues

If Delimiter = vbNullChar Then
Delimiter = Chr(7)
Text = Replace(Text, vbNullChar, Delimiter)
End If

sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""") &
"""}"
aryEval = Evaluate(sFormula)
ReDim aryValues(0 To UBound(aryEval) - 1)
For i = 0 To UBound(aryValues)
aryValues(i) = aryEval(i + 1)
Next

Split = aryValues

End Function

'---------------------------------------------------------------------------
Public Function InStrRev(stringcheck As String, _
ByVal stringmatch As String, _
Optional ByVal start As Long = -1)
'---------------------------------------------------------------------------
Dim iStart As Long
Dim iLen As Long
Dim i As Long

If iStart = -1 Then
iStart = Len(stringcheck)
Else
iStart = start
End If

iLen = Len(stringmatch)

For i = iStart To 1 Step -1
If Mid(stringcheck, i, iLen) = stringmatch Then
InStrRev = i
Exit Function
End If
Next i
InStrRev = 0
End Function
'-----------------------------------------------------------------
#End If


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Haraki" <[email protected]> wrote in message
news:[email protected]...
> Is it possible for me to extract all of the files within a specific folder
> into excel using vba?
> Example: I would like to dump the name of each file located in the
> follwoing path C:\My Documents\
>
>
> Thanks in advance for any help that can be offered.

Or you can use

Application.FileSearch

Take a lok at the example in the Excel help´

Using the FileSearch Object
Use the FileSearch property to return the FileSearch object. The following
example searches for files and displays the number of files found and the
name of each file.

With Application.FileSearch
If .Execute() > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For i = 1 To .FoundFiles.Count
MsgBox .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
End If
End With
Use the NewSearch method to reset the search criteria to the default
settings. All property values are retained after each search is run, and by
using the NewSearch method you can selectively set properties for the next
file search without manually resetting previous property values. The
following example resets the search criteria to the default settings before
beginning a new search.

With Application.FileSearch
.NewSearch
.LookIn = "C:\My Documents"
.SearchSubFolders = True
.FileName = "Run"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
End With

HTH
KM

"Haraki" wrote:

> Is it possible for me to extract all of the files within a specific folder
> into excel using vba?
> Example: I would like to dump the name of each file located in the
> follwoing path C:\My Documents\
>
>
> Thanks in advance for any help that can be offered.

Thanks to all for your help!

"Bob Phillips" wrote:

> Option Explicit
>
> Private cnt As Long
> Private arfiles
> Private level As Long
>
> Sub Folders()
> Dim i As Long
> Dim sFolder As String
> Dim iStart As Long
> Dim iEnd As Long
> Dim fOutline As Boolean
>
> arfiles = Array()
> cnt = -1
> level = 1
>
> sFolder = "E:\"
> ReDim arfiles(2, 0)
> If sFolder <> "" Then
> SelectFiles sFolder
> Application.DisplayAlerts = False
> On Error Resume Next
> Worksheets("Files").Delete
> On Error GoTo 0
> Application.DisplayAlerts = True
> Worksheets.Add.Name = "Files"
> With ActiveSheet
> For i = LBound(arfiles, 2) To UBound(arfiles, 2)
> If arfiles(0, i) = "" Then
> If fOutline Then
> Rows(iStart + 1 & ":" & iEnd).Rows.Group
> End If
> With .Cells(i + 1, arfiles(2, i))
> .Value = arfiles(1, i)
> .Font.Bold = True
> End With
> iStart = i + 1
> iEnd = iStart
> fOutline = False
> Else
> .Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(2, i)), _
> Address:=arfiles(0, i), _
> TextToDisplay:=arfiles(1, i)
> iEnd = iEnd + 1
> fOutline = True
> End If
> Next
> .Columns("A:Z").ColumnWidth = 5
> End With
> End If
> 'just in case there is another set to group
> If fOutline Then
> Rows(iStart + 1 & ":" & iEnd).Rows.Group
> End If
>
> Columns("A:Z").ColumnWidth = 5
> ActiveSheet.Outline.ShowLevels RowLevels:=1
> ActiveWindow.DisplayGridlines = False
>
> End Sub
>
> '-----------------------------------------------------------------------
> Sub SelectFiles(Optional sPath As String)
> '-----------------------------------------------------------------------
> Static FSO As Object
> Dim oSubFolder As Object
> Dim oFolder As Object
> Dim oFile As Object
> Dim oFiles As Object
> Dim arPath
>
> If FSO Is Nothing Then
> Set FSO = CreateObject("Scripting.FileSystemObject")
> End If
>
> If sPath = "" Then
> sPath = CurDir
> End If
>
> arPath = Split(sPath, "\")
> cnt = cnt + 1
> ReDim Preserve arfiles(2, cnt)
> arfiles(0, cnt) = ""
> arfiles(1, cnt) = arPath(level - 1)
> arfiles(2, cnt) = level
>
> Set oFolder = FSO.GetFolder(sPath)
> Set oFiles = oFolder.Files
> For Each oFile In oFiles
> cnt = cnt + 1
> ReDim Preserve arfiles(2, cnt)
> arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
> arfiles(1, cnt) = oFile.Name
> arfiles(2, cnt) = level + 1
> Next oFile
>
> level = level + 1
> For Each oSubFolder In oFolder.Subfolders
> SelectFiles oSubFolder.Path
> Next
> level = level - 1
>
> End Sub
>
> #If VBA6 Then
> #Else
> '-----------------------------Â*Â*-----------------------------Â*-Â*------
> Function Split(Text As String, _
> Optional Delimiter As String = ",") As Variant
> '-----------------------------Â*Â*-----------------------------Â*-Â*------
> Dim i As Long
> Dim sFormula As String
> Dim aryEval
> Dim aryValues
>
> If Delimiter = vbNullChar Then
> Delimiter = Chr(7)
> Text = Replace(Text, vbNullChar, Delimiter)
> End If
>
> sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""") &
> """}"
> aryEval = Evaluate(sFormula)
> ReDim aryValues(0 To UBound(aryEval) - 1)
> For i = 0 To UBound(aryValues)
> aryValues(i) = aryEval(i + 1)
> Next
>
> Split = aryValues
>
> End Function
>
> '---------------------------------------------------------------------------
> Public Function InStrRev(stringcheck As String, _
> ByVal stringmatch As String, _
> Optional ByVal start As Long = -1)
> '---------------------------------------------------------------------------
> Dim iStart As Long
> Dim iLen As Long
> Dim i As Long
>
> If iStart = -1 Then
> iStart = Len(stringcheck)
> Else
> iStart = start
> End If
>
> iLen = Len(stringmatch)
>
> For i = iStart To 1 Step -1
> If Mid(stringcheck, i, iLen) = stringmatch Then
> InStrRev = i
> Exit Function
> End If
> Next i
> InStrRev = 0
> End Function
> '-----------------------------------------------------------------
> #End If
>
>
> --
> HTH
>
> Bob Phillips
>
> (replace somewhere in email address with gmail if mailing direct)
>
> "Haraki" <[email protected]> wrote in message
> news:[email protected]...
> > Is it possible for me to extract all of the files within a specific folder
> > into excel using vba?
> > Example: I would like to dump the name of each file located in the
> > follwoing path C:\My Documents\
> >
> >
> > Thanks in advance for any help that can be offered.
>
>
>