Forum

Bypass $RECYCLE.BIN...
 
Notifications
Clear all

Bypass $RECYCLE.BIN & System Volume Information

11 Posts
3 Users
0 Reactions
204 Views
(@karl-harvey)
Posts: 13
Active Member
Topic starter
 

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.BINS-1-5-18

 
Posted : 24/12/2023 10:21 am
(@keebellah)
Posts: 373
Reputable Member
 

I would suggest you include a check for the foldername if it contains RECYCLE skip it.

 
Posted : 25/12/2023 3:48 am
(@karl-harvey)
Posts: 13
Active Member
Topic starter
 

How do I do that?

 
Posted : 25/12/2023 11:14 pm
(@keebellah)
Posts: 373
Reputable Member
 

How's your VBA knowledge and which version of Excel are you using?

Can you post the code block that you're using now?

 
Posted : 27/12/2023 3:46 am
(@karl-harvey)
Posts: 13
Active Member
Topic starter
 

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.com/author/philipt
' My Online Training Hub http://www.myonlinetraininghub.com/Create-Hyperlinked-List-of-Files-in-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

 
Posted : 27/12/2023 12:05 pm
(@keebellah)
Posts: 373
Reputable Member
 

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?

 
Posted : 28/12/2023 3:58 am
(@karl-harvey)
Posts: 13
Active Member
Topic starter
 

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?

 
Posted : 28/12/2023 9:24 am
(@debaser)
Posts: 838
Member Moderator
 

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.com/author/philipt
' My Online Training Hub http://www.myonlinetraininghub.com/Create-Hyperlinked-List-of-Files-in-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

 
Posted : 28/12/2023 11:20 am
(@karl-harvey)
Posts: 13
Active Member
Topic starter
 

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

 
Posted : 28/12/2023 2:02 pm
(@keebellah)
Posts: 373
Reputable Member
 

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

 
Posted : 29/12/2023 3:17 am
(@karl-harvey)
Posts: 13
Active Member
Topic starter
 

Thank you very much, Hans!

 
Posted : 30/12/2023 2:50 am
Share: