Help with recurse subdirectories code in excel file index sheet
 

Hi,

I need some help with this piece of code, which I think was created by Bob
Philips. I want to put the first directory after the root - in a8
"firstPath" and the remaining path in the next column "secondPath" on my
spreadsheet, (leaving the remaining code untouched). e.g. P:\Howwood
Station\Proforma\Fabric\

I want to be able to autofilter by station name (Howwood Station)

[Sheet1 Code]
Private Sub cmdGet_Click()
Dim cRows As Long

cRows = Cells(Rows.Count, Range("firstPath").Column).End(xlUp).Row
With Range("firstpath")
If cRows = .Row Then
Range(Cells(.Row, .Column), Cells(cRows, .Column)).ClearContents
End If
End With

With Range("firstfile")
If cRows = .Row Then
Range(Cells(.Row, .Column), Cells(cRows, .Column)).ClearContents
End If
End With

With Range("firstLink")
If cRows = .Row Then
Range(Cells(.Row, .Column), Cells(cRows, .Column)).ClearContents
End If
End With

LoopFolders Range("root").Value, "Type 1 Font file"

End Sub

[Module1 Code]
Option Explicit

Dim objFSO As Object
Dim iPathCol As Long
Dim iFileCol As Long
Dim iLinkCol As Long
Dim iFile As Long
Dim sRoot As String

Function LoopFolders(startPath As String, _
Optional filetype As String = "Type 1 Font file", _
Optional subfolders As Boolean = True)

' Create named Ranges, for the appropriate columns in Row 8 of Worksheet
iPathCol = Range("firstPath").Column
iFileCol = Range("firstFile").Column
iLinkCol = Range("firstLink").Column
iFile = Range("firstpath").Row
sRoot = startPath

Set objFSO = CreateObject("Scripting.FileSystemObject")

selectFiles startPath, filetype, subfolders

Set objFSO = Nothing

End Function
'---------------------------------------------------------------------------
Sub selectFiles(ByVal sPath As String, _
ByVal filetype As String, _
ByVal subfolders As Boolean)
'---------------------------------------------------------------------------
Dim oFolder As Object
Dim oFldr As Object
Dim oFiles As Object
Dim oFile As Object

'This uses FSO (FileSystemObject) which is an MS scripting facility to
'access many aspects of the file system.
'It uses late-binding, so no need to set a reference.
'It uses a recursive function (selectfiles) that is entered with the
'start folder, and if it finds any folders within, re-enters itself with
'the new folder as the argument.

Set oFolder = objFSO.GetFolder(sPath)

' If there are files in the folder, process each file, and if the
' file is of the nominated filetype, strip the root folder and
' filename from the filepath.
If oFolder.Files.Count 0 Then
For Each oFile In oFolder.Files
If oFile.Type = filetype Then
'Then put Filename in the specified column of the worksheet
Cells(iFile, iPathCol).Value = Mid(oFile.Path, Len(sRoot) +
1, FindBack(oFile.Path, "\") + 1 - (Len(sRoot) + 1))
Cells(iFile, iFileCol) = oFile.Name
' And a link in the Hyperlink column
Cells(iFile, iLinkCol).FormulaR1C1 = "=HYPERLINK(root &
RC[-2] & RC[-1] ,""HERE"")"
iFile = iFile + 1
End If
Next oFile
End If

'This puts Subfolders' Paths in the specified column of the worksheet
If subfolders Then
For Each oFldr In oFolder.subfolders
selectFiles oFldr.Path, filetype, True
Next oFldr
End If

End Sub