Combine recursive listing with excluded code

[anmac1789]

If all you want to do is keep a 'running list' of PATHs that have passed, a simple .RemoveDuplicates() would work

What do you mean by this?

[Paul_Hossler]

What do you mean by this?

Every run will add the files/folders that are not excluded by that run and any paths added by that run which are already in the list will be deleted

[anmac1789]

I was just wondering why do you have a second module with this code:

Option Explicit

Sub Macro1()
    ' Macro1 Macro
    ActiveSheet.Range("$A$1:$H$104").RemoveDuplicates Columns:=1, Header:=xlYes
End Sub

Sub Macro2()
' Macro2 Macro
'
End Sub

when you have :

Private Sub RemoveDups()
    wsOut.Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
End Sub

and also from here:

Call GetFiles(oFSO.GetFolder(RemovePrefix(sPathTop)))    
    wsOut.Cells(rowStart, colFileFolder).Value = "Parent Folder"
    RemoveDups
    Cleanup

which already removes duplicates as intended

Also, i have tested out a parent folder path which is 243 characters long and the files within it did not get listed even thought I have attached a " \\?\ " prefix to take care of long file names...

[Paul_Hossler]

1. I recorded Macro1() just to get an idea of the syntax to incorporate and forgot to delete it. You can delete it

2. I didn't make any extra long folders. Try removing the RemovePrefix logic and see if that works

[anmac1789]

2. I didn't make any extra long folders. Try removing the RemovePrefix logic and see if that works

Do you mean this logic here:

Private Function RemovePrefix(s As String) As String
    If Len(s) < 5 Then
        RemovePrefix = s
    Else
        RemovePrefix = IIf(Left(s, 4) = "\\?\", Right(s, Len(s) - 4), s)
    End If
End Function

[Paul_Hossler]

Did some experimenting and the results were confusing. I'm not too sure the FSO treats "\\?" consistently


Try this and see if you can get rid of using the "\\?"



https://www.itprotoday.com/windows-1...ort-windows-10

Q. How do I enable long file name support in Windows 10?A. In the past the maximum supported file length was 260 characters (256 usable after the drive characters and termination character). In Windows 10 long file name support can be enabled which allows file names up to 32,767 characters (although you lose a few characters for mandatory characters that are part of the name). To enable this perform the following:

1. Start the registry editor (regedit.exe)
2. Navigate to HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\FileSystem
3. Double click LongPathsEnabled
4. Set to 1 and click OK
5. Reboot

This can also be enabled via Group Policy via Computer Configuration > Administrative Templates > System > Filesystem > Enable NTFS long paths.

[anmac1789]

oh...ive done that already and its enabled. When I disabled

ActiveSheet.Range("$A$1:$H$104").RemoveDuplicates Columns:=1, Header:=xlYes

and ran my code on the long folder path I got a run-time error '76': path not found...

[anmac1789]

Any cause for the error in the previous post?

[Paul_Hossler]

Any cause for the error in the previous post?

Couldn't tell you. My macro doesn't generate any errors:

Private Sub RemoveDups()
    wsOut.Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
End Sub

But I explicitly specify the worksheet (wsOut and not ActiveSheet) and explicitly use the entire CurrentRegion (and not hardcoded A1:H104)

If I had to guess, I'd suspect that the currently active worksheet is not the one with the file data

[anmac1789]

This is in response to the previous post. I am attaching 2 workbook so you can take a closer look at the errors

[Paul_Hossler]

Afraid I'm not seeing the errors when I test using my shorter folder trees

I'm not sure what would caused the CountIf 1004 error. A manual WS formula works fine

Your top path is 290 characters and I tried to copy it, but bumped up against the limit and I didn't want to change my PC configuration to try and go longer

and there seems to be a lot of redundancy and very long folder names

Could you get it to something shorter?

[anmac1789]

The previous versions of excludes seemed to work perfectly fine and it was showing up very long folder paths without errors. I dont' know why but just yesterday I was having problems listing long folder paths, it didn't have this kind of error before...

may i ask please not to show the full folder path, I just didn't want to show my name...let me change the names out and put something random

Would it be possible just to enable long folder paths in your registry just for this problem?

[Paul_Hossler]

OK ...

Note that my top path is on D: so change it to C: if necessary

Option Explicit


Const sPathTop As String = "\\?\D:\test one"


Const colPath As Long = 1
Const colParent As Long = 2
Const colName As Long = 3
Const colFileFolder As Long = 4
Const colCreated As Long = 5
Const colModified As Long = 6
Const colSize As Long = 7
Const colType As Long = 8


Dim aryExclude As Variant
Dim rowOut As Long
Dim oFSO As Object
Dim wsOut As Worksheet
Dim rPrev As Range


Sub Start()
    Dim rowStart As Long
    Dim oFile As Object
    
'    aryExclude = Array("\\?\C:\test\subfolder 1", "\\?\C:\test\subfolder 2", "\\?\C:\test\subfolder 3")
    aryExclude = Array("")


    Init


    rowStart = rowOut


    Call GetFiles(oFSO.GetFolder(sPathTop))
    
    wsOut.Cells(rowStart, colFileFolder).Value = "Parent Folder"
    
    RemoveDups
    
    Cleanup
End Sub






Sub GetFiles(oPath As Object)
    Dim oFolder As Object, oSubFolder As Object, oFile As Object


    If IsExcluded(oPath) Then Exit Sub  '   stops recursion
        
    Call ListInfo(oPath, "Subfolder")
    
    For Each oFile In oPath.Files
        Call ListInfo(oFile, "File")
    Next
    
    For Each oSubFolder In oPath.SubFolders
        Call GetFiles(oSubFolder)
    Next
End Sub


'============================================================================
Private Sub Init()
    Dim i As Long
    
    Application.ScreenUpdating = False
    
    If IsArray(aryExclude) Then
        For i = LBound(aryExclude) To UBound(aryExclude)
            aryExclude(i) = CStr(aryExclude(i))
        Next i
    End If
    
    Set wsOut = Worksheets("Files")
    
    With wsOut
        'get last used row, or 1 if empty
        rowOut = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        If rowOut = 1 Then          '   blank sheet
            .Cells(rowOut, colPath).Value = "FILE/FOLDER PATH"
            .Cells(rowOut, colParent).Value = "PARENT FOLDER"
            .Cells(rowOut, colName).Value = "FILE/FOLDER NAME"
            .Cells(rowOut, colFileFolder).Value = "FILE or FOLDER"
            .Cells(rowOut, colCreated).Value = "DATE CREATED"
            .Cells(rowOut, colModified).Value = "DATE MODIFIED"
            .Cells(rowOut, colSize).Value = "SIZE"
            .Cells(rowOut, colType).Value = "TYPE"
        End If
        
        rowOut = rowOut + 1
        
        'save the previous data
        Set rPrev = wsOut.Cells(1, 1).CurrentRegion
    End With
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
End Sub


Private Sub Cleanup()
    wsOut.Columns(colName).HorizontalAlignment = xlLeft
    wsOut.Columns(colCreated).NumberFormat = "m/dd/yyyy"
    wsOut.Columns(colModified).NumberFormat = "m/dd/yyyy"
    wsOut.Columns(colSize).NumberFormat = "#,##0,.0 ""KB"""
    
    wsOut.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
    
    Application.ScreenUpdating = True


    MsgBox "Done"
End Sub


Private Sub RemoveDups()
    wsOut.Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
End Sub


'   IFolder object
'       Attributes, DateCreated, DateLastAccessed, DateLastModified, Drive,
'       Files, IsRootFolder, Name, ParentFolder (IFolder), Path,
'       ShortName, ShortPath, Size, SubFolders, Type


'   iFile object
'       Attributes, DateCreated, DateLastAccessed, DateLastModified, Drive (IDrive),
'       Name, ParentFolder (IFolder), Path, ShortName, ShortPath, Size, Type
'       Attributes


Private Sub ListInfo(oFolderFile As Object, sType As String)
    With oFolderFile
        wsOut.Cells(rowOut, colPath).Value = .Path
        wsOut.Cells(rowOut, colParent).Value = oFSO.GetParentFolderName(.Path)  '   <<<<<<<<<<
        wsOut.Cells(rowOut, colName).Value = .Name
        wsOut.Cells(rowOut, colFileFolder).Value = sType
        wsOut.Cells(rowOut, colCreated).Value = .DateCreated
        wsOut.Cells(rowOut, colModified).Value = .DateLastModified
        wsOut.Cells(rowOut, colSize).Value = .Size
        wsOut.Cells(rowOut, colType).Value = .Type
    End With
    
    rowOut = rowOut + 1
End Sub


Private Function IsExcluded(p As Object) As Boolean
    Dim i As Long
    
    If IsEmpty(aryExclude) Then
        IsExcluded = False
        Exit Function
    End If
    
    IsExcluded = True


    For i = LBound(aryExclude) To UBound(aryExclude)
        If UCase(p.Path) = UCase(aryExclude(i)) Then Exit Function  '   <<<<<<<
    Next i


    IsExcluded = False
End Function

[snb]

See:

https://www.snb-vba.eu/VBA_Recursion_en.html#L_6.1

[anmac1789]

I want to extend my code to have a parent folder list in column J and an exclude list in column K. The below code is in module 2. I found that instead of writing each parent folder in "sPathTop", I could've listed the parent folders in column J (or any other column) and then ran the main code. I just don't know how to run the main code for each parent folder in column J while taking into account the exclude list in column K. In other words, how can I include the below code to run with my main code? Thanks

Sub examplearray()
    Dim testarray() As String, size As Integer, i As Integer, x As Variant
    size = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlDown)))
    ReDim testarray(size)
    'Range("L2") = LBound(testarray)
    'Range("L3") = UBound(testarray)
    For i = 1 To size
        testarray(i) = Range("A" & i).Value
    Next i
End Sub

[anmac1789]

It seems like there is a number of changes in the current version of excludes_14 from previous versions:
These have been removed, from comparing the older versions of exclude_#.xlsx with excludes_14.xlsx
1.

Dim numRuns As Long

has been removed

2.

        'see how many runs were packed in by counting "Parent Folder"
        numRuns = Application.WorksheetFunction.CountIf(wsOut.Columns(colFileFolder), "Parent Folder")

has been removed

3.

If numRuns > 0 Then RemoveDups

has been removed

4.

Private Sub RemoveDups()
    Dim rowNew As Long
    For rowNew = wsOut.Cells(1, 1).CurrentRegion.Rows.Count To rPrev.Rows.Count + 1 Step -1
        If Application.WorksheetFunction.CountIf(rPrev.Columns(colParent), wsOut.Cells(rowNew, colParent).Value) > 0 Then
            'mark special
            wsOut.Cells(rowNew, colParent).Value = True
        End If
    Next rowNew
    On Error Resume Next
    wsOut.Columns(colParent).SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
    On Error GoTo 0
End Sub

has been changed to:

Private Sub RemoveDups()
    wsOut.Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
End Sub

Does this new code do exactly the above code and only keeps 1 type of entry and removes all other duplicates from column 1?

Also,

wsOut.Cells(rowOut, colParent).Value = RemovePrefix(.ParentFolder.path)

has been modified to

wsOut.Cells(rowOut, colParent).Value = oFSO.GetParentFolderName(.Path)

isnt .ParentFolder.path the same thing as oFSO.GetParentFolderName(.Path) ??

Private Function RemovePrefix(s As String) As String
    If Len(s) < 5 Then
        RemovePrefix = s
    Else
        RemovePrefix = IIf(Left(s, 4) = "\\?\", Right(s, Len(s) - 4), s)
    End If
End Function

has been removed.. Why is this so?

For i = LBound(aryExclude) To UBound(aryExclude)
      aryExclude(i) = RemovePrefix(CStr(aryExclude(i)))
Next i

has been changed to:

For i = LBound(aryExclude) To UBound(aryExclude)
            aryExclude(i) = CStr(aryExclude(i))
        Next i

This only removes the long folder path prefix from the exclude list and not the parent folder column (2). It was done before in previous workbooks but not the new excludes_14...

How come:

Call GetFiles(oFSO.GetFolder(RemovePrefix(sPathTop)))

generates error message saying "Run time error '76': Path not found" for the same parent folder even if its a longer folder path exceeding 260 characters??

[anmac1789]

looking back at excludes_5,

I had a code which highlights duplicates in red colour using the below code:

module 2 code:

Option Explicit


Sub sbFindDuplicatesInColumn_C()
Dim i As Long


'Declaring the lastRow variable as Long to store the last row value in the Column1
    Dim lastRow As Long


'matchFoundIndex is to store the match index values of the given value
    Dim matchFoundIndex As Long


'iCntr is to loop through all the records in the column 1 using For loop
    Dim iCntr As Long


'Finding the last row in the Column 1
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row     'Range("A65000").End(xlUp).Row


'looping through the column1
    For iCntr = 1 To lastRow
        'checking if the cell is having any item, skipping if it is blank.
        If Cells(iCntr, 1) <> "" Then
            'getting match index number for the value of the cell
            matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)
            'if the match index is not equals to current row number, then it is a duplicate value
            If iCntr <> matchFoundIndex Then
                'Printing the label in the column B
                 Cells(iCntr, 1).Interior.Color = RGB(255, 12, 0)
                 Cells(iCntr, 2) = "there are duplicates here!"
            End If
        End If
    Next
End Sub

For a path that is for example, 52 characters long the above code highlights duplicates in column 1. But, I have a path that is 611 characters long, and for some reason it does not detect duplicates OR highlights them, instead returns an error message:

run-time error 13: type mismatch, when I click debug it highlights "matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)" in module 2

Main code in module 1:

Option Explicit


'>>>> this is for a path that is 52 characters long, including the long folder path prefix in the beginning
'>>>> duplicates are detected for this path (in column 1) and removed properly
'Const sPathTop As String = "\\?\C:\Users\abcde\Downloads\downloads abc 123 docs"


'>>>> this is for a path that is 611 characters long, including the long folder path prefix in the beginning
'>>>> duplicates are NOT detected for this path (in column 1) and gives run-time error 13: type mismatch, highlighting "highlighting matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)" in module 2
Const sPathTop As Variant = "\\?\C:\Users\nrhfy\Downloads\seagate 500\Documents and Settings\abcd\AppData\Local\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Application Data\Adobe\Acrobat\11.0"


Const colPath As Long = 1
Const colParent As Long = 2
Const colName As Long = 3
Const colFileFolder As Long = 4
Const colCreated As Long = 5
Const colModified As Long = 6
Const colSize As Long = 7
Const colType As Long = 8


Dim aryExclude As Variant
Dim rowOut As Long
Dim oFSO As Object
Dim wsOut As Worksheet
Dim sParentFolder As Variant


Sub Start()
    Dim rowStart As Long
 
    aryExclude = Array("")
    
    Init


    rowStart = rowOut
    sParentFolder = RemovePrefix(sPathTop)


    Call GetFiles(oFSO.GetFolder(sPathTop))
    
    wsOut.Cells(rowStart, colFileFolder).Value = "Parent Folder"
    
    'wsOut.Columns(5).NumberFormat = "m/dd/yyyy"
    'wsOut.Columns(6).NumberFormat = "m/dd/yyyy"
    'wsOut.Columns(7).NumberFormat = "#,##0,.0 ""KB"""


End Sub


Sub GetFiles(oPath As Object)
    Dim oFolder As Object, oSubFolder As Object, oFile As Object


    If IsExcluded(oPath) Then Exit Sub  '   stops recursion
        
    sParentFolder = IIf(Left(oPath.path, 4) = "\\?\", Right(oPath.path, Len(oPath.path) - 4), oPath.path)
        
    Call ListInfo(oPath, "Subfolder")
    
    For Each oFile In oPath.Files
        Call ListInfo(oFile, "File")
    Next
    
    For Each oSubFolder In oPath.SubFolders
        Call GetFiles(oSubFolder)
    Next
End Sub


'============================================================================
Private Sub Init()
    Set wsOut = Worksheets("Sheet2")
    
    With wsOut
    
        rowOut = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        If rowOut = 1 Then          '   blank sheet
            .Cells(rowOut, 1).Value = "FILE/FOLDER PATH"
            .Cells(rowOut, 2).Value = "PARENT FOLDER"
            .Cells(rowOut, 3).Value = "FILE/FOLDER NAME"
            .Cells(rowOut, 4).Value = "FILE or FOLDER"
            .Cells(rowOut, 5).Value = "DATE CREATED"
            .Cells(rowOut, 6).Value = "DATE MODIFIED"
            .Cells(rowOut, 7).Value = "SIZE"
            .Cells(rowOut, 8).Value = "TYPE"
        End If
        
        rowOut = rowOut + 1
        
    End With


    Set oFSO = CreateObject("Scripting.FileSystemObject")
End Sub


'   IFolder object
'       Attributes, DateCreated, DateLastAccessed, DateLastModified, Drive,
'       Files, IsRootFolder, Name, ParentFolder (IFolder), Path,
'       ShortName, ShortPath, Size, SubFolders, Type


'   iFile object
'       Attributes, DateCreated, DateLastAccessed, DateLastModified, Drive (IDrive),
'       Name, ParentFolder (IFolder), Path, ShortName, ShortPath, Size, Type
'       Attributes


Private Sub ListInfo(oFolderFile As Object, sType As String)
    With oFolderFile
        wsOut.Cells(rowOut, colPath).Value = RemovePrefix(.path)
        wsOut.Cells(rowOut, colParent).Value = RemovePrefix(Left(.path, Len(.path) - Len(.Name) - 1))
        wsOut.Cells(rowOut, colName).Value = .Name
        wsOut.Cells(rowOut, colFileFolder).Value = sType
        wsOut.Cells(rowOut, colCreated).Value = .DateCreated
        wsOut.Cells(rowOut, colModified).Value = .DateLastModified
        wsOut.Cells(rowOut, colSize).Value = .Size
        wsOut.Cells(rowOut, colType).Value = .Type
    End With
    
    rowOut = rowOut + 1
End Sub


Private Function IsExcluded(p As Object) As Boolean
    Dim i As Long
    
    IsExcluded = True
    
    For i = LBound(aryExclude) To UBound(aryExclude)
        If UCase(p.path) = UCase(aryExclude(i)) Then Exit Function
    Next i
    
    IsExcluded = False
End Function


Private Function RemovePrefix(s As String) As String
    If Len(s) < 5 Then
        RemovePrefix = s
    Else
        RemovePrefix = IIf(Left(s, 4) = "\\?\", Right(s, Len(s) - 4), s)
    End If
End Function

I am not understanding why it would not highlight because i can list the folders with long folder path recursively without errors and I would think that highlighting doesn't depend on the number of characters in a string...what is the solution to this?

[Paul_Hossler]

For a path that is for example, 52 characters long the above code highlights duplicates in column 1. But, I have a path that is 611 characters long, and for some reason it does not detect duplicates OR highlights them, instead returns an error message:

run-time error 13: type mismatch, when I click debug it highlights "matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)" in module 2

https://exceljet.net/formula/match-l...compare%20text.


[QUOTE]
The MATCH function has a limit of 255 characters for the lookup value. If you try to use longer text, MATCH will return a #VALUE error. To workaround this limit you can use boolean logic and the LEFT, MID, and EXACT functions to parse and compare text./QUOTE]


You could generate a hash code for each entry and MATCH() against those

[anmac1789]

You could generate a hash code for each entry and MATCH() against those

What does this mean?

[Paul_Hossler]

LMGTFY

https://en.wikipedia.org/wiki/Hash_function

A hash function is any function that can be used to map data of arbitrary size to fixed-size values. The values returned by a hash function are called hash values, hash codes, digests, or simply hashes. The values are usually used to index a fixed-size table called a hash table. Use of a hash function to index a hash table is called hashing or scatter storage addressing.

I had a Hash module that I added to the attachment.
The test data in the attachment (your folder tree) was order randomized
The MarkDupsWithHash sub was run to mark dups in red
The data was resorted as a check

Option Explicit


Sub MarkDupsWithHash()
    Dim r As Range
    Dim aryHash() As String
    Dim i As Long, j As Long
    
    'test
    Worksheets("Files").Columns(1).Interior.ColorIndex = xlColorIndexNone
    
    
    Set r = Worksheets("Files").Cells(1, 1)
    Set r = Range(r, r.End(xlDown))


    ReDim aryHash(1 To r.Rows.Count)


    For i = LBound(aryHash) To UBound(aryHash)
        aryHash(i) = CreateSHA256HashString(r.Cells(i, 1).Value)
    Next i


    For i = LBound(aryHash) To UBound(aryHash) - 1
        For j = i + 1 To UBound(aryHash)
            If aryHash(j) = aryHash(i) Then r.Cells(j, 1).Interior.Color = vbRed
        Next j
    Next i


    MsgBox "Done"


End Sub

If you don't want to use a Hash, then the For i / For j loops should also work, but will be slower I think