Consulting

Page 3 of 7 FirstFirst 1 2 3 4 5 ... LastLast
Results 41 to 60 of 125

Thread: Combine recursive listing with excluded code

  1. #41
    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?

  2. #42
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Quote Originally Posted by anmac1789 View Post
    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #43
    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...
    Last edited by anmac1789; 03-02-2021 at 10:42 PM.

  4. #44
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  5. #45
    Quote Originally Posted by Paul_Hossler View Post
    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

  6. #46
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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.
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  7. #47
    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...

  8. #48
    Any cause for the error in the previous post?

  9. #49
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Quote Originally Posted by anmac1789 View Post
    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
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

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

  11. #51
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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?
    Last edited by Paul_Hossler; 03-10-2021 at 02:05 PM.
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  12. #52
    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?

  13. #53
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  14. #54

  15. #55
    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

  16. #56
    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??

  17. #57
    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?

  18. #58
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location

    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

    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  19. #59
    You could generate a hash code for each entry and MATCH() against those


    What does this mean?

  20. #60
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •