Log In
Register
Home
November 9, 2023
Offline
The original version of this file was downloaded from here. I have modified it slightly. It currently fails when it encounters the $RECYCLE.BIN folder. Can the VBA code be updated to bypass the $RECYCLE.BIN and System Volume Information folders, please?
Highlighted line of code when debugging:
'Get the first file, look for Normal, Read Only, System and Hidden files
TargetFiles = StartingFolder.Path & "\" & FileType
Debug.Print StartingFolder.Path
CurrentFilename = Dir(TargetFiles, 7)
Immediate window (from the Debug.Print StartingFolder.Path line):
W:\
W:\$RECYCLE.BIN
W:\$RECYCLE.BIN\S-1-5-18
Trusted Members
October 17, 2018
Online
I would suggest you include a check for the foldername if it contains RECYCLE skip it.
November 9, 2023
Offline
How do I do that?
Trusted Members
October 17, 2018
Online
How's your VBA knowledge and which version of Excel are you using?
Can you post the code block that you're using now?
November 9, 2023
Offline
Microsoft 365, Version 2311 Build 16.0.17029.20028
I have little to no knowledge of VBA. I've attached the Excel file but I think this is where your suggested code would go:
Sub ListFilesInSubFolders(StartingFolder As Scripting.Folder, LinksTable As ListObject, ByRef ArrResults() As String)
' Written by Philip Treacy, http://www.myonlinetraininghub.....or/philipt
' My Online Training Hub http://www.myonlinetraininghub.....Subfolders
' May 2014
' Lists all files specified by FileType in all subfolders of the StartingFolder object.
' This sub is called recursively
Dim CurrentFilename As String
Dim OffsetRow As Long
Dim TargetFiles As String, NewRow As Range
Dim SubFolder As Scripting.Folder
'Get the first file, look for Normal, Read Only, System and Hidden files
TargetFiles = StartingFolder.Path & "\" & FileType
Debug.Print StartingFolder.Path
CurrentFilename = Dir(TargetFiles, 7)
Do While CurrentFilename <> ""
Counter = Counter + 1
ReDim Preserve ArrResults(1 To 2, 1 To Counter)
ArrResults(1, Counter) = StartingFolder.Path & "\"
ArrResults(2, Counter) = CurrentFilename
'Get the next file
CurrentFilename = Dir
Loop
' For each SubFolder in the current StartingFolder call ListFilesInSubFolders (recursive)
' The sub continues to call itself for each and every folder it finds until it has
' traversed all folders below the original StartingFolder
For Each SubFolder In StartingFolder.SubFolders
ListFilesInSubFolders SubFolder, LinksTable, ArrResults
Next SubFolder
End Sub
Trusted Members
October 17, 2018
Online
i checked the code included my check but it doesn't return any filenames.
will need to test some more
what's you OS and which excel version are you using?
November 9, 2023
Offline
I'm using Excel as part of Microsoft 365 - the version is 2311 Build 16.0.17029.20028. I'm using Windows 10 Pro x64.
Did you run it on the root of a drive?
Trusted Members
Moderators
November 1, 2018
Offline
Try amending the second sub to:
Sub ListFilesInSubFolders(StartingFolder As Scripting.Folder, LinksTable As ListObject, ByRef ArrResults() As String)
' Written by Philip Treacy, http://www.myonlinetraininghub.....or/philipt
' My Online Training Hub http://www.myonlinetraininghub.....Subfolders
' May 2014
' Lists all files specified by FileType in all subfolders of the StartingFolder object.
' This sub is called recursively
Dim CurrentFilename As String
Dim OffsetRow As Long
Dim TargetFiles As String, NewRow As Range
Dim SubFolder As Scripting.Folder
On Error GoTo err_handle
If InStr(1, StartingFolder.Path, "\$", vbTextCompare) = 0 Then ' skip folders starting with $
'Get the first file, look for Normal, Read Only, System and Hidden files
TargetFiles = StartingFolder.Path & "\" & FileType
'Debug.Print StartingFolder.Path
CurrentFilename = Dir(TargetFiles, 7)
Do While CurrentFilename <> ""
Counter = Counter + 1
ReDim Preserve ArrResults(1 To 2, 1 To Counter)
ArrResults(1, Counter) = StartingFolder.Path & "\"
ArrResults(2, Counter) = CurrentFilename
'Get the next file
CurrentFilename = Dir
Loop
' For each SubFolder in the current StartingFolder call ListFilesInSubFolders (recursive)
' The sub continues to call itself for each and every folder it finds until it has
' traversed all folders below the original StartingFolder
For Each SubFolder In StartingFolder.SubFolders
ListFilesInSubFolders SubFolder, LinksTable, ArrResults
Next SubFolder
End If
Exit Sub
err_handle:
If Err.Number <> 70 Then ' not a permission denied error, so carry on to the next one
Resume Next
End If
End Sub
November 9, 2023
Offline
Thanks, Velouria. I tried the updated version but unfortunately it failed on the first sub:
' Call recursive sub to list files
ListFilesInSubFolders FSOFolder, LinksTable, ArrResults
If Counter > 0 Then 'there is data in results array
LinksTable.Resize LinksTable.Parent.Range(LinksTable.Range.Cells(1), LinksTable.Range.Cells(LinksTable.ListColumns.Count).Offset(Counter, 0))
Union(LinksTable.ListColumns(1).DataBodyRange, LinksTable.ListColumns(2).DataBodyRange).Value = TransposeArray(ArrResults)
'LinksTable.DataBodyRange.Value = TransposeArray(ArrResults)
End If
Trusted Members
October 17, 2018
Online
Sorry for the delay but this one works
I added thsi udf as a test in the code
Public Function check_folder_is_valid(myVariant As Variant) As Boolean
Dim check_folder As Variant, errNo As Long
On Error Resume Next
check_folder = Dir(myVariant, 7)
errNo = Err.Number
Err.Clear
On Error GoTo 0
check_folder_is_valid = errNo = 0
End Function
1 Guest(s)
