Combine recursive listing with excluded code

Quote:

---

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?

Quote:

---

Originally Posted by anmac1789

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

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

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 :

Code:

---

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

---

and also from here:

Code:

---

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

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

Quote:

---

Originally Posted by Paul_Hossler

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:

Code:

---

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

---

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

Quote:

---

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.

---

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

Quote:

---

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

Any cause for the error in the previous post?

Quote:

---

Originally Posted by anmac1789

Any cause for the error in the previous post?

---

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

Code:

---

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

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

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?

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?

OK ...

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

Code:

---

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

---

See:

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

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

Code:

---

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

---

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.

Code:

---

Dim numRuns As Long

---

has been removed

2.

Code:

---

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

---

has been removed

3.

Code:

---

If numRuns > 0 Then RemoveDups

---

has been removed

4.

Code:

---

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:

Code:

---

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,

Code:

---

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

---

has been modified to

Code:

---

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

---

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

Code:

---

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?

Code:

---

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

---

has been changed to:

Code:

---

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:

Code:

---

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??

looking back at excludes_5,

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

module 2 code:

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:

Code:

---

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?

Quote:

---

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

Quote:

---

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

---

What does this mean?

LMGTFY

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

Quote:

---

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

Code:

---

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

I was looking at worksheetfunction.unique() from this website: https://www.reddit.com/r/excel/comme...s_and_methods/ to extract unique values but it seem it doesn't print the unique values to a range, it only stores them within each element of the array

I am trying to use cells to execute my code for each folder path and run my code but the furthest that I have gone is just getting an example of a for each...next loop and don't know how to proceed. Here is my code:

Code:

---

Sub example()


Dim cell As Range


For Each cell In Range("A2", Range("A2").End(xlDown))
cell.Font.Color = 255
Next cell


End Sub

---

The problem with this code is that if only cell A2 is filled in and then I run Sub example(), I get a "Code execution has been interrupted" error. However, when I have 2 cells filled in, cell A2 and A3, then there is no error. Why doesn't one cell (cell A2) work ??

This is an example, but what I want to do is instead of manually inserting each file/folder path inside sPathTop and executing my main code, I want to manually write the folder path(s) in suppose cell A1 and then run my main code on this folder path into another worksheet. This way, I wouldn't have to go back and change sPathTop for each additional folder path that I add. it solves one problem but it gives another. Finding duplicates is already inserted on a different sub which we solved using hashes, but another problem is to also include a exclude folder path list suppose in cell B1.. I have went back to the main code and i see that spathtop is a constant but How do I store different folder paths inside a range, its making me think of arrays..so I'm not sure. How do I proceed? Thanks...

Changes and comments/suggestions

Code:

---

Option Explicit


Sub example()
    'better not to use VBA reserved words, less confusing
    Dim rCell As Range


    'as it was, whatever the activesheet was would be used
    .need the dot on the Range(A2)'s
    With Worksheets("Sheet1")


        'the Range around (A2) was missing
        For Each rCell In Range(.Range("A2"), .Range("A2").End(xlDown))
            rCell.Font.Color = 255
        Next
    End With
End Sub

---

Suggestion: by starting in A2 and going down, the selection will end at a cell above a blank cell, and if there are data filled cells below, they won't be included

I've found it's safer to start at the bottom of the worksheet and go up to make the end cell the one with data

Code:

---

Sub example2()
    Dim rCell As Range, rColor As Range


    With Worksheets("Sheet1")
        Set rColor = .Range("A2")
        Set rColor = Range(rColor, .Cells(.Rows.Count, 1).End(xlUp))
       
        'the Range around (A2) was missing
        For Each rCell In rColor.Cells
            rCell.Font.Color = 255
        Next
    End With
End Sub

---

Quote:

---

This is an example, but what I want to do is instead of manually inserting each file/folder path inside sPathTop and executing my main code, I want to manually write the folder path(s) in suppose cell A1 and then run my main code on this folder path into another worksheet. This way, I wouldn't have to go back and change sPathTop for each additional folder path that I add. it solves one problem but it gives another. Finding duplicates is already inserted on a different sub which we solved using hashes, but another problem is to also include a exclude folder path list suppose in cell B1.. I have went back to the main code and i see that spathtop is a constant but How do I store different folder paths inside a range, its making me think of arrays..so I'm not sure. How do I proceed? Thanks...

---

What if I wanted to extend the red cell method for file/folder paths in my main code ??

This loops a list of 3 folders

Within the loop, you could use Dir() to get the files, etc.

Code:

---


Option Explicit


Sub example3()
    Dim vPath As Variant


    For Each vPath In Array("C:\Users", "D:\Music", "L:\Quicken")
       
        MsgBox vPath & " -- " & FileDateTime(vPath)
   
    Next
End Sub

---

Quote:

---

Within the loop, you could use Dir() to get the files, etc.

---

is it possible to store cell values of a range and reference them in an array using a variable which dynamically shortens or lengthens and then use a Call statement to execute a main code for each element inside that array ?

Yes, not sure about the "which dynamically shortens or lengthens" part

Code:

---

Option Explicit

Sub LoadArray()
    Dim a As Variant
    Dim B As Variant
    Dim i As Long
   
    'needed to make a 1 dim array
    a = Application.WorksheetFunction.Transpose(ActiveSheet.Cells(1, 1).CurrentRegion)


    'we can use this as a 2 dim array
    B = ActiveSheet.Cells(1, 3).CurrentRegion
   
    For i = LBound(a) + 1 To UBound(a)
        Call SubA(a(i))
    Next i
   
    For i = LBound(B, 1) + 1 To UBound(B, 1)
        Call SubB(B(i, 1), B(i, 2))
    Next i
   


End Sub


Sub SubA(N As Variant)
    MsgBox "SubA  " & 10 * N
End Sub


Sub SubB(N1 As Variant, N2 As Variant)
    MsgBox "SubB    " & N1 * N2
End Sub

---

Quote:

---

Yes, not sure about the "which dynamically shortens or lengthens" part

---

What I mean by this is that the number of entries dynamically changes with each folder path addition or deletion.

Lets say in Sheet1 I have:

cell A2 = folderpath1
cell A3 = folderpath2
cell A3 = folderpath3

How can I execute the below code on each folder path above and get the result of the search in Sheet2 ??

Code:

---

Private Sub ListInfo(oFolderFile As Object, sType As String)
    With oFolderFile
        wsOut.Cells(rowOut, colPath).Value = RemovePrefix(.Path)
        wsOut.Cells(rowOut, colParent).Value = RemovePrefix(oFSO.GetParentFolderName(.Path))  'oFSO.GetParentFolderName(.Path) or .ParentFolder.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

---

Please take a look at the example workbook attached..

Code fragment that may help

Code:

---

Option Explicit


Dim rowNext As Long
Dim ws1 As Worksheet, ws2 As Worksheet
   


Sub LoadArray()
    Dim aryFolders As Variant
    Dim aryParameters As Variant
    Dim i As Long
   
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
   
    'needed to make a 1 dim array
    aryFolders = Application.WorksheetFunction.Transpose(ws1.Cells(1, 1).CurrentRegion)


    'next blank row
    rowNext = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
   
    For i = LBound(aryFolders) + 1 To UBound(aryFolders)
        Call ListInfo(aryFolders(i), i)
    Next i
   
End Sub




Sub ListInfo(S As Variant, N As Long)
'Sub ListInfo(oFolderFile As Object, sType As String)
'    With oFolderFile
'        wsOut.Cells(rowOut, colPath).Value = RemovePrefix(.Path)
'        wsOut.Cells(rowOut, colParent).Value = RemovePrefix(oFSO.GetParentFolderName(.Path))  'oFSO.GetParentFolderName(.Path) or .ParentFolder.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


    With ws2.Rows(rowNext)
        .Cells(1).Value = S
        .Cells(2).Value = N
        .Cells(3).Value = 2 * N
        .Cells(4).Value = 4 * N
        .Cells(5).Value = N ^ 2
        .Cells(6).Value = N / 2
    End With
   
    rowNext = rowNext + 1
End Sub

---

But, how can I use the filesystemobject properties together with arrays ?

I don't have your latest version, but this is one way to store the FSO properties in an array

The For/Next and Do/Loop will need to be integrated into the overall macro

Code:

---

Option Explicit


Dim aryCount As Long
Dim aryData(1 To 1000, 1 To 8) As Variant


Dim ws1 As Worksheet, ws2 As Worksheet
   


Sub LoadArray()
    Dim aryFolders As Variant
    Dim i As Long
   
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
   
    'needed to make a 1 dim array
    aryFolders = Application.WorksheetFunction.Transpose(ws1.Cells(1, 1).CurrentRegion)


    aryCount = 0
       
    For i = LBound(aryFolders) + 1 To UBound(aryFolders)
                   
        'do loop files and folder in aryFolders
            Call ListInfo(FileorFolderObject, FileorFolderType)
        'loop
    Next i
End Sub




Sub ListInfo(oFolderFile As Object, sType As String)
    aryCount = aryCount + 1
    With oFolderFile
        aryData(aryCount, 1) = RemovePrefix(.Path)
        aryData(aryCount, 2) = RemovePrefix(oFSO.GetParentFolderName(.Path))
        aryData(aryCount, 3) = .Name
        aryData(aryCount, 4) = sType
        aryData(aryCount, 5) = .DateCreated
        aryData(aryCount, 6) = .DateLastModified
        aryData(aryCount, 7) = .Size
        aryData(aryCount, 8) = .Type
    End With
End Sub

---

The latest version was excludes_14 very little has changed in formatting or newer codes...
It says that variable not defined and "FileorFolderObject" is highlighted

The code in #71 rewritten.

Reduce the amount of variables to a minimum.
Use Arrays to read data, to store calculated/adapted data, and to write them in 1 movement into the workbook.
Reduce the interaction with the workbook to: reading once, writing once.

Code:

---

Sub M_snb()
  sn = Sheet1.Cells(1).CurrentRegion.Resize(, 9)                            '    reading
   
  With CreateObject("scripting.filesystemobject")
    For j = 1 To UBound(sn)
      With .getfolder(sn(j, 1))
        For jj = 2 To UBound(sn, 2)
          sn(j, jj) = Choose(jj, "", .Path, .Drive, .Name, .Type, .datecreated, .datelastmodified, .Size, .Type)
        Next
      End With
    Next
  End With
   
  Sheet1.Cells(1).CurrentRegion.Resize(, 9) = sn                          '      writing
End Sub

---

1. I attached an expanded copy of your test folder (this is my folder files to test on.zip)

2. Excludes_15 has a loop to read the folders to recurse on the worksheet FoldersToDo. Includes a second call to a folder to test dup removal

3. Remove Dups looks in column A of the output sheet since that's what Excluded_14 does

4. There is no need avoid writing directly to the output worksheet. It goes quickly enough

5. Folders to exclude can also be a list on FoldersToDo




Edit --

I decided to use a different approach for collecting data in ver 17

Quote:

---

5. Folders to exclude can also be a list on FoldersToDo

---

Does this go in column 2 of 'FoldersToDo' worksheet ? because I see 'Generate Duplicates' is added there..

No, that was just a note that the second call to that folder will Generate Duplicates, and I wanted to make sure that they were removed

Probably something like this for the Excludes

I'm still not sure about how you want to define what gets excluded when you have an Excluded Folder

Attachment 28430


Decided to go a different approach for collecting file/folder data in ver 17

Quote:

---

I'm still not sure about how you want to define what gets excluded when you have an Excluded Folder

---

so basically, if a folder is listed as being excluded, then everything inside that parent folder and the parent folder itself should get excluded I would say...if it were written as a path that would make it easier because it pinpoints exactly what gets excluded weather its a entire folder path or a specific set of file(s)

Quote:

---

Originally Posted by anmac1789

so basically, if a folder is listed as being excluded, then everything inside that parent folder and the parent folder itself should get excluded I would say...if it were written as a path that would make it easier because it pinpoints exactly what gets excluded weather its a entire folder path or a specific set of file(s)

---

Check that Excludes_17.xlsm does it that way

it only changes with the folder/file name. So I changed this section of the code:

Quote:

---

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

---

Edit: I Just found out it only excludes folders not actual file(s). I will try to find some kind of readjustment to exclude in addition to file path(s)

Not seeing that

I think it excludes the folders in the Col C list and the files within those folders/subfolders

Attachment 28436

'subfolder 2' is on the Exclude list and a 'Find' on the listings in Col A does not see it

I prefixed the files in 'subfolder 2' with 'Exclude' just to make sure

So if that's NOT what you want, you'll need to be more specific