Combine recursive listing with excluded code

[anmac1789]

This questions is an extension from this thread: http://www.vbaexpress.com/forum/show...ths-list/page2.

if you run this code with any chosen parent directory once, it lists all files and folders for that parent directory. Then, when you click button 1 again to list the same parent directory or a different parent directory, it adds to the previous list and continues on down to list files/folders for the new parent directory AFTER the 1st list. I've demonstrated that in the attached workbook using colour codes. The next thing is that the 2nd code has the excluded folder paths code. Now what I want to do is to combine both codes together into one code which has the recursive repeat list from the 1st code and the exclude folder paths code from the 2nd code...

This is the code in reference to the attached workbook:

Option Explicit
Sub SomeSub()
'ActiveSheet.Columns("A:H").ClearContents
    Call GetFiles("\\?\C:\test one") 'attach "\\?\" at the beginning for long folder path names! ex..'GetFiles("\\?\INSERT..." 'can also list multiple "Call GetFiles("\\?\[insert new folder path here]")" to list multiple folder paths all at once
End Sub
Sub GetFiles(ByVal path As String)

Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")


Dim folder As Object
Set folder = FSO.GetFolder(path)


Dim SubFolder As Object
Dim file As Object


'Range("A1") = "FILE/FOLDER PATH"
'Range("A1").Offset(0, 1) = "parent folder"
'Range("A1").Offset(0, 2) = "FILE/FOLDER NAME"
'Range("A1").Offset(0, 3) = "FILE or FOLDER"
'Range("A1").Offset(0, 4) = "DATE CREATED"
'Range("A1").Offset(0, 5) = "DATE MODIFIED"
'Range("A1").Offset(0, 6) = "SIZE"
'Range("A1").Offset(0, 7) = "TYPE"


    Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Replace(folder, "\\?\", "")
    Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Replace(Left(folder, (Len(folder) - Len(folder.Name) - 1)), "\\?\", "")
    Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = folder.Name
    Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = "folder"
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = folder.datecreated
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = folder.DateLastModified


'For Each SubFolder In folder.Subfolders
    'Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Replace(SubFolder.path, "\\?\", "")
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Replace(folder, "\\?\", "")
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = SubFolder.Name
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = "SUB FOLDER"
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = SubFolder.datecreated
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = SubFolder.DateLastModified
'Next SubFolder


For Each file In folder.Files
    Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Replace(file.path, "\\?\", "")
    Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Replace(folder, "\\?\", "")
    Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = file.Name
    Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = "FILE"
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = file.datecreated
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = file.DateLastModified
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 6) = file.Size
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 7) = file.Type
Next file

For Each SubFolder In folder.Subfolders
GetFiles (SubFolder.path)
Next

With Range("F:G")
.NumberFormat = "dddd mmmm dd, yyyy H:mm:ss AM/PM" 'long file date and time
End With


'ActiveSheet.UsedRange.EntireColumn.AutoFit


Set FSO = Nothing
Set SubFolder = Nothing
Set folder = Nothing
Set file = Nothing


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

This is the second code which has excluded folder paths:

Option Explicit

Const sPathTop As String = ""


Dim aryExclude As Variant
Dim o As Long
Dim FSO As Object


Sub Start()
    aryExclude = Array("C:\test one\subfolder 1") 'place excluded folder paths here!!
    
    o = 2


    'ActiveSheet.Columns("A:H").Clear    '   testing purposes


    Set FSO = CreateObject("Scripting.FileSystemObject")


    Call GetFiles(FSO.GetFolder("C:\test one")) 'attach "\\?\" at the beginning for long folder path names! ex..'GetFiles("\\?\INSERT..." 'can also list multiple "Call GetFiles("\\?\[insert new folder path here]")" to list multiple folder paths all at once


End Sub


Sub GetFiles(oPath As Object)
    Dim oFolder As Object, oSubFolder As Object, oFile As Object
    
    'Cells(1, 1).Value = "FILE/FOLDER PATH"
    'Cells(1, 1).Offset(0, 1).Value = "PARENT FOLDER"
    'Cells(1, 1).Offset(0, 2).Value = "FILE/FOLDER NAME"
    'Cells(1, 1).Offset(0, 3).Value = "FILE or FOLDER"
    'Cells(1, 1).Offset(0, 4).Value = "DATE CREATED"
    'Cells(1, 1).Offset(0, 5).Value = "DATE MODIFIED"
    'Cells(1, 1).Offset(0, 6).Value = "SIZE"
    'Cells(1, 1).Offset(0, 7).Value = "TYPE"


    If Not IsExcluded(oPath) Then
        ActiveSheet.Cells(o, 1).Value = Replace(oPath.path, "\\?\", "")
        ActiveSheet.Cells(o, 2).Value = Replace(Left(oPath.path, (Len(oPath.path) - Len(oPath.Name) - 1)), "\\?\", "") 'parent folder for subfolders
        ActiveSheet.Cells(o, 3).Value = oPath.Name
        ActiveSheet.Cells(o, 4).Value = "folder"
        ActiveSheet.Cells(o, 5).Value = oPath.datecreated
        ActiveSheet.Cells(o, 6).Value = oPath.datelastmodified
        o = o + 1
        
        For Each oFile In oPath.Files
            ActiveSheet.Cells(o, 1).Value = Replace(oFile.path, "\\?\", "")
            ActiveSheet.Cells(o, 2).Value = Replace(Left(oFile.path, (Len(oFile.path) - Len(oFile.Name) - 1)), "\\?\", "") 'parent folder for files
            ActiveSheet.Cells(o, 3).Value = oFile.Name
            ActiveSheet.Cells(o, 4).Value = "file"
            ActiveSheet.Cells(o, 5).Value = oFile.datecreated
            ActiveSheet.Cells(o, 6).Value = oFile.datelastmodified
            ActiveSheet.Cells(o, 7).Value = oFile.Size
            ActiveSheet.Cells(o, 8).Value = oFile.Type
            o = o + 1
        Next
        
        For Each oSubFolder In oPath.SubFolders
            Call GetFiles(oSubFolder)
        Next
        
        With Range("E:F")
        .NumberFormat = "dddd mmmm dd, yyyy H:mm:ss AM/PM" 'long file date and time
        End With
    
    End If
    
        ActiveSheet.UsedRange.EntireColumn.AutoFit


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

I have tried myself to understand subroutine arguements from the 1st code and 2nd code and tried to comebine them together into one code but I always receive a compile error. it seems like the problem is stemming from not understanding the difference between

Sub GetFiles(oPath As Object)

and

Sub GetFiles(ByVal path As String)

and

For Each SubFolder In folder.Subfolders
GetFiles (SubFolder.path)
Next

I hope someone can shed some light onto how I can combine the two codes together....

[Paul_Hossler]

I'm still not sure about some things that you're doing, but I still had my test folder tree so I took another look

This seems to work

IMHO it's better to modularize and have subs/functions that can be used and which only perform one function

So there's Init(), ListInfor(), etc.

You can make the code more elegant, but I sort of brute forced a lot of it.

I also deleted your "\\?" since I didn't need it

Option Explicit


Const sPathTop As String = "D:\Test"


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


Sub Start()
    aryExclude = Array( _
        "D:\Test\111\111CCC\111CCC111", _
        "D:\Test\333\333AAA", _
        "D:\Test\333\333BBB" _
        )
    
    Init


    Call GetFiles(oFSO.GetFolder(sPathTop))
    
    wsOut.Columns(5).NumberFormat = "m/dd/yyyy"
    wsOut.Columns(6).NumberFormat = "m/dd/yyyy"
    wsOut.Columns(7).NumberFormat = "#,##0,.0 ""KB"""


    MsgBox "Done"
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, "Folder")
    
    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("Files")
    
    rowOut = 1
    
    With wsOut
        .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 With


    rowOut = rowOut + 1


    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(oFile As Object, sType As String)
    With oFile
        wsOut.Cells(rowOut, 1).Value = .path
        wsOut.Cells(rowOut, 2).Value = .ParentFolder.path
        wsOut.Cells(rowOut, 3).Value = .Name
        wsOut.Cells(rowOut, 4).Value = sType
        wsOut.Cells(rowOut, 5).Value = .DateCreated
        wsOut.Cells(rowOut, 6).Value = .DateLastModified
        wsOut.Cells(rowOut, 7).Value = .Size
        wsOut.Cells(rowOut, 8).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

[anmac1789]

Also, this code doesn't continue to the list after the 1st search it clears the worksheet and starts a new search instead of continuing down. From what I've gathered, using

Range("A" & Rows.Count).End(xlUp).Offset(0, 1)

does the trick of continuing with the list downwards. But I dont know if this is making the code more complicated or making it run slower..

IMHO it's better to modularize and have subs/functions that can be used and which only perform one function

Do you mean to put subroutine codes for files, subfolders, parent folder in it's own module?

You can make the code more elegant, but I sort of brute forced a lot of it. I also did no final formatting (mm/dd/yyyy for dates and n,nnn KB for sizes)

To make this code much simpler and easier/faster to run do you mean to use arrays ? Also, I can change the date and time format to how I want later on after it's searched through all files/folders...unless there's a faster way of declaring the formatting at the beginning of the code so it doesn't have to wait until after the code has completed...

How come in this code:

Private Sub ListFolder(oFolder As Object)    With oFolder
        wsOut.Cells(rowOut, 1).Value = .path
        wsOut.Cells(rowOut, 2).Value = .ParentFolder.path
        wsOut.Cells(rowOut, 3).Value = .Name
        wsOut.Cells(rowOut, 4).Value = "Folder"
        wsOut.Cells(rowOut, 5).Value = .DateCreated
        wsOut.Cells(rowOut, 6).Value = .DateLastModified
        wsOut.Cells(rowOut, 7).Value = .Size
        wsOut.Cells(rowOut, 8).Value = .Type
    End With
    
    rowOut = rowOut + 1
End Sub

the line with

wsOut.Cells(rowOut, 4).Value = "Folder"

doesn't show the column with "folder" but instead it shows "subfolder"

I just found out that leaving this code out makes no difference in listing the subfolder path and as well as the parent folder paths! that's a bit strange...

Private Sub ListFolder(oFolder As Object)
    With oFolder
        wsOut.Cells(rowOut, 1).Value = .path
        wsOut.Cells(rowOut, 2).Value = .ParentFolder.path
        wsOut.Cells(rowOut, 3).Value = .Name
        wsOut.Cells(rowOut, 4).Value = "Folder"
        wsOut.Cells(rowOut, 5).Value = .DateCreated
        wsOut.Cells(rowOut, 6).Value = .DateLastModified
        wsOut.Cells(rowOut, 7).Value = .Size
        wsOut.Cells(rowOut, 8).Value = .Type
    End With
    
    rowOut = rowOut + 1
End Sub

[Paul_Hossler]

I revised my macro a few minutes after I posted it last night at 10:26 since I wanted to simplify some things. Are you looking at the revised version?


1. Changed Init().
Using rowOut (a Long) is faster than tracing several objects and methods

2. No, instead of having basically the same 8 lines to put data onto the worksheet, a separate module (ListInfo) with calling parameters will put it in one place. Also makes the overall macro smaller and maintenance is usually easier

3. Arrays would make part of it faster, but IMHO the bulk of the time is spent getting information about files/folders the complexity wasn't worth it

4. A 'subfolder' is still a 'folder'. Something like oFolder.Subfolders is a collection of Folder objects in oFolder, but For Each returns a Folder object
That's why ListFolder was never used and I replaced ListFile and ListSubfolder with just ListInfo, since they both did 90% the same thing, the old difference being what you call it in cell 4

5. You could format (date, size) each line as you go, but I thinks it's faster to just do the whole column at once


The main recursive code is below, so if you want it to say "Subfolder", change the marked line

    Call ListInfo(oPath, "Folder")  ' <<<<<<<<<<<<<<<
    
    For Each oFile In oPath.Files
        Call ListInfo(oFile, "File")
    Next

Option Explicit


Const sPathTop As String = "D:\Test"


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


Sub Start()
    aryExclude = Array( _
        "D:\Test\111\111CCC\111CCC111", _
        "D:\Test\333\333AAA", _
        "D:\Test\333\333BBB" _
        )
    
    Init


    Call GetFiles(oFSO.GetFolder(sPathTop))
    
    wsOut.Columns(5).NumberFormat = "m/dd/yyyy"
    wsOut.Columns(6).NumberFormat = "m/dd/yyyy"
    wsOut.Columns(7).NumberFormat = "#,##0,.0 ""KB"""


    MsgBox "Done"
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, "Folder")
    
    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("Files")
    
    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"
        
            rowOut = rowOut + 1
        End If
    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(oFile As Object, sType As String)
    With oFile
        wsOut.Cells(rowOut, 1).Value = .path
        wsOut.Cells(rowOut, 2).Value = .ParentFolder.path
        wsOut.Cells(rowOut, 3).Value = .Name
        wsOut.Cells(rowOut, 4).Value = sType
        wsOut.Cells(rowOut, 5).Value = .DateCreated
        wsOut.Cells(rowOut, 6).Value = .DateLastModified
        wsOut.Cells(rowOut, 7).Value = .Size
        wsOut.Cells(rowOut, 8).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

[anmac1789]

I see, so the code is a bit shorter now instead of using

Range("A" & Rows.Count).End(xlUp).Offset(0, 1)=

by using

wsOut.Cells(rowOut, 1).Value =

Also, the reason why I used "\\?" prefix is because for long folder path names exceeding 260 or 255 characters because I have one folder which is longer than 255 or 260 characters

I revised my macro a few minutes after I posted it last night at 10:26 since I wanted to simplify some things. Are you looking at the revised version?

I saw that some code was changed yes thats why did a line by line comparison of my code with your code and it seems like not much changed.

4. A 'subfolder' is still a 'folder'. Something like oFolder.Subfolders is a collection of Folder objects in oFolder, but For Each returns a Folder object
That's why ListFolder was never used and I replaced ListFile and ListSubfolder with just ListInfo, since they both did 90% the same thing, the old difference being what you call it in cell 4

Also, I see by removing ListFile and ListSubfolder, the 4th column with the header "FILE or FOLDER" returns only "file" or "folder"....but if I also wanted to say "parent folder" for top level path such as the directory paths used in

Call GetFiles(oFSO.GetFolder("PARENT DIRECTORY"))

and "subfolder" for subfolders after the parent directory and "files" for regular files..Would I still need to make a separate attribute list one for parent directory and another for subfolders and files?

[Paul_Hossler]

I'm not understanding

Every file and every folder has a parent directory

If a folder (#1) contains subfolders (#A, #B, #C) , than #A is also a folder, and has #1 as their parent

In my little test the folder "D:\Test" the the top of the search tree

Are you saying that in the sample below from my test, that you want the BLUE to say "Parent Folder" and the GREEN to say "Subfolder"?


Capture.JPG

A second run on a different top level folder (e.g. F:\Test2) would be / could be labeled as "Parent Folder"

[anmac1789]

Are you saying that in the sample below from my test, that you want the BLUE to say "Parent Folder" and the GREEN to say "Subfolder"?

Yes I was looking for the blue folder to say "parent folder" or any string name like "parent" "top level" etc..and the green to say "subfolder" and the files just regular plain old "file"

A second run on a different top level folder (e.g. F:\Test2) would be / could be labeled as "Parent Folder"

yes the same labels to be repeated for a different (or repeat of the same) parent folder etc..

Also, how come I cannot use "\\?" in the prefix of

Call GetFiles(oFSO.GetFolder("\\?\PARENT DIRECTORY"))

because I was able to do that in

Call GetFiles("\\?\C:\test one")

for shorter file path names from this code:

Option ExplicitSub SomeSub()
'ActiveSheet.Columns("A:H").ClearContents
    Call GetFiles("\\?\C:\test one") 'attach "\\?\" at the beginning for long folder path names! ex..'GetFiles("\\?\INSERT..." 'can also list multiple "Call GetFiles("\\?\[insert new folder path here]")" to list multiple folder paths all at once
End Sub
Sub GetFiles(ByVal path As String)


Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")


Dim folder As Object
Set folder = FSO.GetFolder(path)


Dim SubFolder As Object
Dim file As Object


'Range("A1") = "FILE/FOLDER PATH"
'Range("A1").Offset(0, 1) = "parent folder"
'Range("A1").Offset(0, 2) = "FILE/FOLDER NAME"
'Range("A1").Offset(0, 3) = "FILE or FOLDER"
'Range("A1").Offset(0, 4) = "DATE CREATED"
'Range("A1").Offset(0, 5) = "DATE MODIFIED"
'Range("A1").Offset(0, 6) = "SIZE"
'Range("A1").Offset(0, 7) = "TYPE"


    Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Replace(folder, "\\?\", "")
    Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Replace(Left(folder, (Len(folder) - Len(folder.Name) - 1)), "\\?\", "")
    Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = folder.Name
    Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = "folder"
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = folder.datecreated
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = folder.DateLastModified


'For Each SubFolder In folder.Subfolders
    'Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Replace(SubFolder.path, "\\?\", "")
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Replace(folder, "\\?\", "")
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = SubFolder.Name
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = "SUB FOLDER"
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = SubFolder.datecreated
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = SubFolder.DateLastModified
'Next SubFolder


For Each file In folder.Files
    Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Replace(file.path, "\\?\", "")
    Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Replace(folder, "\\?\", "")
    Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = file.Name
    Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = "FILE"
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = file.datecreated
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = file.DateLastModified
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 6) = file.Size
    'Range("A" & Rows.Count).End(xlUp).Offset(0, 7) = file.Type
Next file


For Each SubFolder In folder.Subfolders
GetFiles (SubFolder.path)
Next


With Range("F:G")
.NumberFormat = "dddd mmmm dd, yyyy H:mm:ss AM/PM" 'long file date and time
End With


'ActiveSheet.UsedRange.EntireColumn.AutoFit


Set FSO = Nothing
Set SubFolder = Nothing
Set folder = Nothing
Set file = Nothing

End Sub

Also, using the prefix gives the error: "Run-time error 76: Path not found" when i click debug it highlights this line

wsOut.Cells(rowOut, 2).Value = .ParentFolder.path

Does this line

Sub GetFiles(ByVal path As String)

have anything to do with accepting the longer path prefix or no?

[Paul_Hossler]

Also, how come I cannot use "\\?" in the prefix of
Call GetFiles(oFSO.GetFolder("\\?\PARENT DIRECTORY"))

Probably because there is not a folder on disk called PARENT DIRECTORY.

.ParentFolder is a property of the File and the Folder objects

I don't know why the \\?\ prefix causes an error


Capture.JPG



Try this as a workaround

Option Explicit

Const sPathTop As String = "\\?\D:\Test"


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


Sub Start()
    Dim rowStart As Long
    aryExclude = Array( _
        "\\?\D:\Test\111\111CCC\111CCC111", _
        "\\?\D:\Test\333\333AAA", _
        "\\?\D:\Test\333\333BBB" _
        )
    
    Init


    rowStart = rowOut
    sParentFolder = RemovePrefix(sPathTop)


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


    MsgBox "Done"
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("Files")
    
    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"
        
            rowOut = rowOut + 1
        End If
    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, 1).Value = RemovePrefix(.path)
'        wsOut.Cells(rowOut, 2).Value = .ParentFolder.path
        wsOut.Cells(rowOut, 2).Value = sParentFolder
        wsOut.Cells(rowOut, 3).Value = .Name
        wsOut.Cells(rowOut, 4).Value = sType
        wsOut.Cells(rowOut, 5).Value = .DateCreated
        wsOut.Cells(rowOut, 6).Value = .DateLastModified
        wsOut.Cells(rowOut, 7).Value = .Size
        wsOut.Cells(rowOut, 8).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
    RemovePrefix = IIf(Left(s, 4) = "\\?\", Right(s, Len(s) - 4), s)
End Function

[anmac1789]

Probably because there is not a folder on disk called PARENT DIRECTORY.

I meant that has a generic placeholder for any parent directory of your choosing

I don't know why the \\?\ prefix causes an error

How come I cant use something simple like this

Replace(folder path, "\\?\", "")

Also, from post #4, using this code, it overwrites the last line of the folder/file before pressing a button to continue a 2nd search

Option Explicit

Const sPathTop As String = "D:\Test"


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


Sub Start()
    aryExclude = Array( _
        "D:\Test\111\111CCC\111CCC111", _
        "D:\Test\333\333AAA", _
        "D:\Test\333\333BBB" _
        )
    
    Init


    Call GetFiles(oFSO.GetFolder(sPathTop))
    
    wsOut.Columns(5).NumberFormat = "m/dd/yyyy"
    wsOut.Columns(6).NumberFormat = "m/dd/yyyy"
    wsOut.Columns(7).NumberFormat = "#,##0,.0 ""KB"""


    MsgBox "Done"
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, "Folder")
    
    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("Files")
    
    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"
        
            rowOut = rowOut + 1
        End If
    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(oFile As Object, sType As String)
    With oFile
        wsOut.Cells(rowOut, 1).Value = .path
        wsOut.Cells(rowOut, 2).Value = .ParentFolder.path
        wsOut.Cells(rowOut, 3).Value = .Name
        wsOut.Cells(rowOut, 4).Value = sType
        wsOut.Cells(rowOut, 5).Value = .DateCreated
        wsOut.Cells(rowOut, 6).Value = .DateLastModified
        wsOut.Cells(rowOut, 7).Value = .Size
        wsOut.Cells(rowOut, 8).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

So for example, suppose there's 10 files, 7 folders for a total of =17 objects in a parent directory. When searching the first time, it produces 17 objects correctly. Searching again recursively of the same parent directory overwrites the last line from the 1st search and produces 17 more objects. In total, only 33 objects were listed instead of 34

Sorry, I know it seems im picking out every detail but it seems like we're close

[Paul_Hossler]

New Init() in #8

Private Sub Init()
    Set wsOut = Worksheets("Files")
    
    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

[anmac1789]

okay so that makes sense, it is listing the correct number of files/folders. Oh shoot! I just thought of something right now... I don't know if I should make a new thread or continue posting here...it is related somewhat to this topic...

let's say I have two subfolders within a parent folder and I wanted to remove or add a subfolder to the search list after the 1st search, if I search again it's going to duplicate some results like the parent directory or other subfolders in the 2nd search result (in other words, going to make a duplicate list). Basically this means that whenever a new subfolder/parent directory is added/removed, is there a way to check for duplicated folder paths and remove them (let's say after the 2nd search, 3rd search etc..etc..)? so as there is only one folder/file path and it's attributes in the search list?

..this sounds complicated...so I should we solve this with VBA code or instead use built-in excel functions?

so it looks like, I have found one code that does what I want it to, except I don't know to erase the rows. I found this from another website and I don't know if this code can be simplified further:

Sub sbFindDuplicatesInColumn_C()'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 = 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).Value, 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, 9) = "duplicate"
            End If
        End If
    Next
End Sub

[Paul_Hossler]

Added new Sub to remove duplicate and some cleanup

It looks at just Parent values for the lines that were just added (another run) and if the Parent is in the previous data, marks and deletes the just added row

'look at newly added lines (not in rPrev) and if PARENT FOLDER is in rPrev delete from newly added
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
            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

[anmac1789]

well, I know your trying your best here, but if I had several nested subfolders with the same names then if just the parent values were being looked at then additional folder paths would be removed that's not intended to.

What I mean here is that, folder/file paths uniquely identify each parent folder, each file, each subfolder...so even if they have the same "end" name they would be at a different level...hence which is why I figure out right now that folder/file paths is the best way to remove duplicates.

What I found over the internet is to mark duplicates with a colour and check if they are actual duplicate/repeated values due to multiple searches and then delete those entries.

To expand on this, I have made 3 buttons, 1 button to search everything, 2nd button to find and look for duplicates, third button to remove those highlighted/marked duplicates. However, I see some of your coding looks cleaned up with a bit with constants so I want to use that

I know it is a little complicated to understand but I think i found a way right now...here is the additional code:

Option Explicit

Sub sbFindDuplicatesInColumn_C()
'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 = 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).EntireRow.Delete
                 Cells(iCntr, 1).Interior.Color = RGB(255, 20, 0)
                 'Cells(iCntr, 9) = "duplicate"
            End If
        End If
    Next
End Sub




'Sub DeleteRowswithSpecificValue()
'Dim i As Variant
'For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
'If Cells(i, 1).Value = "c:\test with spaces" Then
'Cells(i, 1).Interior.Color = RGB(255, 0, 0)
'Cells(i, 3).Interior.Color = RGB(0, 255, 0)
'Cells(i, 2).Interior.Color = RGB(0, 255, 255)
'End If
'Next i
'End Sub


Sub Deleteit()
Dim i As Variant
For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
If Cells(i, 1).Interior.Color = RGB(255, 20, 0) Then
Cells(i, 1).EntireRow.Delete
'Cells(i, 1).Interior.Color = RGB(0, 255, 0)
End If
Next i
End Sub

I am wondering if this could be cleaned up or not..and also I have placed this code into a new module (module 2)

[Paul_Hossler]

Confused as to what it is you want

I ran on my test folder tree and excluded "\\?\D:\Test\111" and got the green, rows 2 - 78, with no D:\Test\111, but did include d:\Test\222

Ran again and excluded "\\?\D:\Test\222" and got the yellow, rows 79 - 105. Anything that was not excluded in run 2 (everything except D:\Test\222) but was already included in run 1 was removed

The new items from the second run were d:\Test\111, original excluded from run 1

Capture.jpg

[anmac1789]

Confused as to what it is you want

Oh i see what you are doing, basically after every new run, in the new run whatever files/folders that are included in the previous run, are removed from the newer run..so basically with each new run it's checking back to see if the file/folder exists or not..if not its keeping the file/folder if it does exists it deletes it from the new run. Am I correct in this reasoning?

Basically, my code does exactly what your code does except it lists everything first (excluding defined folder paths), selects or highlights duplicate folder paths and then there's a button to remove them...the end result is similar to your code above

Finally, I think this is what the function does:

D:\Test\111
D:\Test\222
D:\Test\333

run 1: exclude: D:\Test\111, include: D:\Test\222, D:\Test\333
run 2: exclude: D:\Test\222, include: D:\Test\111, D:\Test\333 (D:\Test\333 removed, because it is already listed from run 1)

[Paul_Hossler]

Oh i see what you are doing, basically after every new run, in the new run whatever files/folders that are included in the previous run, are removed from the newer run..so basically with each new run it's checking back to see if the file/folder exists or not..if not its keeping the file/folder if it does exists it deletes it from the new run. Am I correct in this reasoning?

Yes

Basically, my code does exactly what your code does except it lists everything first (excluding defined folder paths), selects or highlights duplicate folder paths and then there's a button to remove them...the end result is similar to your code above

I didn't do it that way since if there were 3-4 runs, and THEN the manual de-dup it would get confusing
Right before each run, the macro knows what the starting data is, and can tell the difference between that 'old' data and the 'new' data being added in the second run to eliminate overlaps from the new data

Finally, I think this is what the function does:

D:\Test\111
D:\Test\222
D:\Test\333

run 1: exclude: D:\Test\111, include: D:\Test\222, D:\Test\333
run 2: exclude: D:\Test\222, include: D:\Test\111, D:\Test\333 (D:\Test\333 removed, because it is already listed from run 1)

Yes

Before:

D:\Test\111
D:\Test\222
D:\Test\333

Run 1: exclude D:\Test\111 from Before

D:\Test\222
D:\Test\333

Run 2: exclude D:\Test\222 from Before

D:\Test\111
D:\Test\333


Result:

D:\Test\222 (from run 1)
D:\Test\333 (from run 1)
D:\Test\111 (from run 2 since 333 was already there)

[anmac1789]

OKay got it..have you tried looking at this code here?

Option Explicit
Sub sbFindDuplicatesInColumn_C()
'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 = 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).EntireRow.Delete
                 Cells(iCntr, 1).Interior.Color = RGB(255, 20, 0)
                 'Cells(iCntr, 9) = "duplicate"
            End If
        End If
    Next
End Sub




'Sub DeleteRowswithSpecificValue()
'Dim i As Variant
'For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
'If Cells(i, 1).Value = "c:\test with spaces" Then
'Cells(i, 1).Interior.Color = RGB(255, 0, 0)
'Cells(i, 3).Interior.Color = RGB(0, 255, 0)
'Cells(i, 2).Interior.Color = RGB(0, 255, 255)
'End If
'Next i
'End Sub


Sub Deleteit()
Dim i As Variant
For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
If Cells(i, 1).Interior.Color = RGB(255, 20, 0) Then
Cells(i, 1).EntireRow.Delete
'Cells(i, 1).Interior.Color = RGB(0, 255, 0)
End If
Next i End Sub

isn't this much simpler ? let me demonstrate by giving you my workbook so u can take a look at it..

[Paul_Hossler]

isn't this much simpler ? let me demonstrate by giving you my workbook so u can take a look at it..

Well, it appears to work, which is always a good thing

I don't find it any simpler or particularly well written, but that doesn't mean that you can't use it

Things like Range("A65000") and just Cells(...) not tied to a specific worksheet (e.g. Worksheets("Data").Cells (1,2)) I find will cause trouble later or that the macro is old and written in Excel 2003 originally

Why would you want 3 steps instead of just 1?

[anmac1789]

Things like Range("A65000") and just Cells(...) not tied to a specific worksheet (e.g. Worksheets("Data").Cells (1,2)) I find will cause trouble later or that the macro is old and written in Excel 2003 originally

I got this originally from the internet, I am relatively new to excel vba but i've been using it for about a month now so I don't know too much about how to make the code simpler and more efficient. I see, what you are trying to say, for example if I wanted to expand even further on this code and have different functionalities in different worksheets so using "Worksheets("Data").Cells (1,2)" this notation will prevent problems from occuring..

Why would you want 3 steps instead of just 1?

usually, I like to see how the code is made up when it's written simply which again ties to what I said above being new and all...I want to learn more about how your code is written it's just a lot of new things are written in it so I don't know what's going on..

[Paul_Hossler]

Well, a lot is just personal style, but there are some things I've learned by making mistakes and/or by seeing how others do it that make it a little more transportable and bullet-proof

For example, using my Init() sub

Instead of using Range("A65000") [probably Excel 2003] which will return wrong answer if more than 65000 rows, I prefer (again, personal choice/style) to use the built in Excel capabilities (#1 below). I've seen Range("A1000") used which will probably fail sooner or later. The #1 works in 2003 and with 1M+ rows, and in 64 bit Excel and if they ever have Excel with 100M+ rows it will still work. More transportable

Just using Cells() refers to the ActiveSheet, which might not be the worksheet that you intended (I've seen many hard to trace bugs because the macro was checking or writing to the wrong worksheet). By using wsOut.Cells(...) (#2 below) it's clear that you're using the cell that you think your are

The bracketing With / End With (#3) is just a way to keep the code more readable (again, personal opinion) since all of the <dot>Cells(...) within are clearly part of the wsOut object

Private Sub Init()
    Set wsOut = Worksheets("Files")
    
    With wsOut                                                      ' <<<<<<<<<<<<<<<<<<<<<<<<<<< #3
    
        rowOut = .Cells(.Rows.Count, 1).End(xlUp).Row               ' <<<<<<<<<<<<<<<<<<<<<<<<<<< #1
        
        If rowOut = 1 Then          '   blank sheet
            .Cells(rowOut, 1).Value = "FILE/FOLDER PATH"            ' <<<<<<<<<<<<<<<<<<<<<<<<<<< #2
            .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"
        
            rowOut = rowOut + 1
        End If
    End With                                                       ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<< #3   


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