Consulting

Page 1 of 7 1 2 3 ... LastLast
Results 1 to 20 of 125

Thread: Combine recursive listing with excluded code

  1. #1

    Combine recursive listing with excluded code

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

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,825
    Location
    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
    Attached Files Attached Files
    Last edited by Paul_Hossler; 02-15-2021 at 08:26 PM. Reason: Modularized and added eye candy to the macro
    ---------------------------------------------------------------------------------------------------------------------

    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. #3
    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
    Last edited by anmac1789; 02-15-2021 at 08:53 PM.

  4. #4
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,825
    Location
    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
    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

  5. #5
    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?

  6. #6
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,825
    Location
    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"
    ---------------------------------------------------------------------------------------------------------------------

    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. #7
    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?
    Last edited by anmac1789; 02-16-2021 at 04:41 PM.

  8. #8
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,825
    Location
    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
    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

  9. #9
    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
    Last edited by anmac1789; 02-16-2021 at 06:51 PM.

  10. #10
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,825
    Location
    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
    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

  11. #11
    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
    Last edited by anmac1789; 02-16-2021 at 09:42 PM.

  12. #12
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,825
    Location
    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
    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

  13. #13
    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)
    Last edited by anmac1789; 02-17-2021 at 12:37 AM.

  14. #14
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,825
    Location
    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
    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

  15. #15
    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)
    Last edited by anmac1789; 02-17-2021 at 02:14 AM.

  16. #16
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,825
    Location
    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)
    ---------------------------------------------------------------------------------------------------------------------

    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

  17. #17
    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..
    Attached Files Attached Files

  18. #18
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,825
    Location
    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?
    ---------------------------------------------------------------------------------------------------------------------

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

  20. #20
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,825
    Location
    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
    ---------------------------------------------------------------------------------------------------------------------

    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
  •