Map/List of folders, subfolders & files
Hi there,
I'd like to create a VBA code, which should generate the map of all folders and subfolders (and their subfolders and so on) of a particular folder, say C:\. The case is like this: I have a folder containing more than 100 subfolders. Each subfolder also contains a variable number of subfolders (from 1 to 20) and so on. The thing is that the total number of folders and subfolders is huge and I have to keep them under control. Can anybody help me? Thanking in advance, Bogdan |
Map/List of folders, subfolders & files
This was previously posted by Bob Phillips:
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 = "C:\" 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 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) level = level + 1 If Not sPath Like "*System Volume Information*" Then For Each oSubFolder In oFolder.subfolders SelectFiles oSubFolder.Path Next End If level = level - 1 End Sub -- Regards, Tom Ogilvy "Bogdan" wrote in message ... Hi there, I'd like to create a VBA code, which should generate the map of all folders and subfolders (and their subfolders and so on) of a particular folder, say C:\. The case is like this: I have a folder containing more than 100 subfolders. Each subfolder also contains a variable number of subfolders (from 1 to 20) and so on. The thing is that the total number of folders and subfolders is huge and I have to keep them under control. Can anybody help me? Thanking in advance, Bogdan |
Map/List of folders, subfolders & files
Thank you very much for your prompt answer. The problem is that is not 100%
functional, as it only display some part of the path. Like for example:"Documents and Settings". The code is too intricated for me to find out where the problem is. BR, Bogdan "Tom Ogilvy" wrote: This was previously posted by Bob Phillips: 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 = "C:\" 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 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) level = level + 1 If Not sPath Like "*System Volume Information*" Then For Each oSubFolder In oFolder.subfolders SelectFiles oSubFolder.Path Next End If level = level - 1 End Sub -- Regards, Tom Ogilvy "Bogdan" wrote in message ... Hi there, I'd like to create a VBA code, which should generate the map of all folders and subfolders (and their subfolders and so on) of a particular folder, say C:\. The case is like this: I have a folder containing more than 100 subfolders. Each subfolder also contains a variable number of subfolders (from 1 to 20) and so on. The thing is that the total number of folders and subfolders is huge and I have to keep them under control. Can anybody help me? Thanking in advance, Bogdan |
Map/List of folders, subfolders & files
Bogdan,
You may want to try the free Excel add-in "List Files". It list folders & files or just folders. The file list is hyperlinked. The list can be sorted. Download from... http://www.realezsites.com/bus/primitivesoftware -- Jim Cone San Francisco, USA "Bogdan" wrote in message Hi there, I'd like to create a VBA code, which should generate the map of all folders and subfolders (and their subfolders and so on) of a particular folder, say C:\. The case is like this: I have a folder containing more than 100 subfolders. Each subfolder also contains a variable number of subfolders (from 1 to 20) and so on. The thing is that the total number of folders and subfolders is huge and I have to keep them under control. Can anybody help me? Thanking in advance, Bogdan |
Map/List of folders, subfolders & files
I guess it is a matter of the intepretation of: generate the map of all
folders Sorry it didn't meet your needs. Perhaps Jim's addin will work. -- Regards, Tom Ogilvy "Bogdan" wrote in message ... Thank you very much for your prompt answer. The problem is that is not 100% functional, as it only display some part of the path. Like for example:"Documents and Settings". |
Map/List of folders, subfolders & files
Hi Tom,
The idea is that the code provided by you is almost good. Something is missing and i really don't have the capabilities to figure out where is the issue. Thus, I'll clarify for you the " generate the map of all folders" and maybe you'll be able to advise me. So, I'd like to obtain in Sheet1 the following: column a: root folder column b: subfolders level 1 column c: subfolder 2, being subfolders of subfolders level .................................................. .................................. column n: subfolders n-1, being subfolders of subfolders level n-2 Maybe is clearer now. anyway, thank you very much for your reply. I'll try to find understand the code and maybe i'll be able to make the adjustment. If so, I'll send the code to you, in case you'll need it sometime. Regards, Bogdan and so on "Tom Ogilvy" wrote: I guess it is a matter of the intepretation of: generate the map of all folders Sorry it didn't meet your needs. Perhaps Jim's addin will work. -- Regards, Tom Ogilvy "Bogdan" wrote in message ... Thank you very much for your prompt answer. The problem is that is not 100% functional, as it only display some part of the path. Like for example:"Documents and Settings". |
All times are GMT +1. The time now is 12:40 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com