LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
dd dd is offline
external usenet poster
 
Posts: 95
Default 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


 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Create Bar code Sheet w/lookups, index/match KalliKay Excel Worksheet Functions 3 September 29th 08 08:05 PM
Getting & Using Sheet Names or Index in VBA code rwjack New Users to Excel 4 April 14th 08 01:50 PM
code to copy excel sheet from 1 file to other ashishprem[_9_] Excel Programming 1 February 28th 06 06:11 AM
list of all subdirectories in a given directory in excel Peter STEVENS Excel Worksheet Functions 3 February 11th 06 03:32 PM
routine won't recurse Eric[_27_] Excel Programming 1 February 2nd 06 08:13 AM


All times are GMT +1. The time now is 08:48 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"