Consulting

Results 1 to 11 of 11

Thread: delete folders on search

  1. #1

    delete folders on search

    Hi all thanks for helping me out with my initial problem on the folder move macro. I have managed to get it working by using a split function with alot of help from a friend in VBA and has the files searched and then moved if in wrong location. one massive thing I misjudged was duplications of the same named folder in each parent folder being searched - E.G New Folder , New Folder 2 etc. how would I go about deleting these files in my current code and still have the others puled across ? if anybody can help this would be great and save me about 4 hours of my day going through 500+ parent folders to just manually delete the unused folders. see code below

    Sub moveFolders()    Dim objFSO As Object
        Dim objFolders As Object
        Dim objFolder As Object
        Dim objFolder2 As Object
        Dim strDirectory As String
        Dim arrFolders() As String
        Dim FolderCount As Long
        Dim FolderIndex As Long
        Dim objFileSystem As Object
        Dim x As Object, XNC As Object
        Dim Y As Integer
        
        
        baseDirectory = "C:\Users\Adam\Desktop\test\"
        archiveDirectory = baseDirectory & "Archive\"
        
        
        strDirectory = baseDirectory
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objFolders = objFSO.GetFolder(strDirectory).SubFolders
        
        For Each objFolder In objFolders
        
            strDirectory2 = strDirectory + objFolder.Name
            Set objFSO2 = CreateObject("Scripting.FileSystemObject")
            Set objFolders2 = objFSO.GetFolder(strDirectory2).SubFolders
            
            parentValues = Split(objFolder, " - ")
            val1_0 = Split(parentValues(0), "\")
            If Not (IsNumeric(val1_0(UBound(val1_0)))) Then
                GoTo 1
            End If
            val1 = CLng(val1_0(UBound(val1_0)))
            val2 = CLng(parentValues(1))
            For Each objFolder2 In objFolders2
                childIs = objFolder2.Name
                Sheets("ARCHIVE").Range("A1000000").End(xlUp).Offset(1) = childIs
                If childIs < CLng(val1) Or childIs > CLng(val2) Then
                    sourceIs = objFolder & "\" & childIs
                    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
                    objFileSystem.MoveFolder Source:=sourceIs, Destination:=archiveDirectory
                    
                    
                End If
            Next
    1
        Next objFolder
        MsgBox ("Done")
    End Sub

  2. #2
    The best solution depends on what exactly you mean by “duplication”.

    If you need to compare whether the content of directories is the same, then I'd recommend an external tool like WinMerge or SearchMyFiles.

    If by “duplication” you mean that the names are in some way similar, then the easiest solution might be around an Excel table, in which you would express the condition of “duplication” with a formula for each folder name that results in a suggestion whether that folder should be deleted. Then you can sort and visually compare those directory names, and override the suggestion as needed.

    To be more concrete: For the formula, it often can be useful to apply a regular expression – see https://strugglingtoexcel.com/2013/1...ssions-in-vba/. If, as one might infer from your example, duplications just differ from the original by an appended space and number, then you can easily get the original name with the formula
    =RegExpReplace(RC[-1]," \d*$", "")
    . In the next column, you can then search with MATCH() whether that name exists in any previous row, and if so, write something like “move” in the cell. Then you can have your macro read that value and handle each row accordingly.

  3. #3
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,704
    Location
    First step is to delete all folders of Size 0
    Recursion is your friend

    Declare objFSO at module level, so the same FSO can be used by all recursions. Set obFSO in the main sub. In the main sub, call the Function described below, passing the root Folder

    Build a Function that will take one Folder, IF it's size is 0 then
    Delete it
    exit Function.
    Declare all needed Variables, Except obFSO, inside the function.
    Else create a list of sub folders,
    for each subfolder, call itself, passing the subfolder
    Next SubFolder
    End IF
    End Function

    That is a nice simple recursive function that should run thru 500 subfolders in 1 or 2 minutes while being a good example of recursiveness,

    As for moving files: At first thought, I would use a Module level Dictionary to keep a list of files that are where they should be, A recursive function can use an outside non recursive function to manipulate the Dictionary for each File. The Dictionary can keep the LastModifiedDate as an Item so you can keep the latest file.Actually, I would use 2 outside functions, 1 to check the dictionary (Delete file if True) and 1 to update it (Continue if True). Both should return Booleans
    Last edited by SamT; 06-23-2021 at 09:50 PM.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  4. #4
    Interesting, SamT, that your approach is so different from mine. In some cases I can see where you're coming from, e.g. returning Booleans is better professional style, and it should give better performance. And removing empty folders first is certainly a nice example for a recursive function that has the didactic advantage to serve as a model for how to do deletion by any other conditions.

    But about the dictionary, why would you not use the convenience of a spreadsheet, when you're already working with Excel?

  5. #5
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,206
    Your concept of archiving hasn't developed beyond filing paper.
    Digital archiving is different.
    Instead of many folders, subfolders you have to devise a systematic scheme how to address files in an unequivocal way. You can give them unique properties (ID) (e.g. in the name, like you would have done in foldernames). A file has many Windows properties nowadays, which can be shown in the explorer.
    If you use this scheme systematically you can store all files in 1 'archive' directory and find each one by its unique ID / property, or a combination of properties.

  6. #6
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,704
    Location
    IIRC, your folders are named by Case Number and the Files by Case Number and Document name. While snb is correct, I believe that your system makes more sense for a legal office

    about the dictionary, why would you not use the convenience of a spreadsheet, when you're already working with Excel?
    Working with ~500 folders and ~500(X) Files is going to take significant time. A Dictionary is just soooooooo much faster than a Spreadsheet. Besides, the FileName already has the folder location built in. All you really need to know is: "Is this the latest file properly stored?" I realize you must also, for legal reasons, archive every document ever created, Thus I would place an Archives folder in each Case folder, since if you ever need the archives, it will be on a Case by Case issue.

    In fact, that operation is so Time consuming that Time becomes of the essence, therefore I would place the Dictionary and the two functions that access it in a Class Module, since CMs run in their own Thread. Save the Dictionary to Excel when Terminating the Class.

    As to Archiving files with the same name, I have set the following as a permanent sub for Excel
    Private Sub Workbook_BeforeSave(''')
        Me.SaveCopyAs ("D:\!Backup\_Personal\Personal - " & CStr(CDbl(Now)) & ".xls")
    End Sub
    Where CStr(CDbl(Now)) is just a unique, (to the millisecond,) ID.
    Neither Windows nor Unix cares if the ID is before or after the file Extension
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  7. #7
    Quote Originally Posted by SamT View Post
    A Dictionary is just soooooooo much faster than a Spreadsheet.
    Thank you, that answers my question. You're right about that, of course. It seems the difference between our approaches is that you're focusing on perfecting the macro, while I want to make the transition from the current manual work process as easy as possible.

  8. #8
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,206
    Dim fs, c01
    
    Sub M_snb()
      c00 = "G:\OF"
      Set fs = CreateObject("scripting.filesystemobject")
       
      M_snbrec c00
       
      MsgBox Join(Filter(Split(c01, vbLf), vbTab & "0"), vbLf), , "Empty Subfolders"
    End Sub
    
    Sub M_snbrec(c00)
      For Each it In fs.getfolder(c00).subFolders
        c01 = c01 & vbLf & it & vbTab & it.Size
        M_snbrec it
      Next
    End Sub
    NB. Adapt the starting directory "G:\OF"

  9. #9
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,704
    Location
    There you go. Run snb's code, save the MsgBox contents to a sheet and have a list of all empty folders.
    I think... snb's code approaches Arthur C. Clarke's definition of magic
    NB. Do not use Option Explicit with any of snb's code
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  10. #10
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,897
    Location
    Here's a (much) wordy-er version that uses the FSO to delete empty folders directly

    Option Explicit
    
    
    Const cTop As String = "D:\Testing"
    
    
    Sub DeleteEmptyFolders()
        Dim oFSO As Object, oFolder As Object
    
    
        'create File System Object
        Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    
        Set oFolder = oFSO.GetFolder(cTop)
    
    
        Call CheckFolder(oFolder)
    End Sub
    
    
    
    
    Private Sub CheckFolder(o As Object)
        Dim oSubFolder As Object
        
    '    Debug.Print "Checking " & o.Path
        For Each oSubFolder In o.SubFolders
            If oSubFolder.Size = 0 Then
    '            Debug.Print "Deleting " & oSubFolder.Path
                oSubFolder.Delete
            Else
                Call CheckFolder(oSubFolder)
            End If
        Next
    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

  11. #11
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,704
    Location
    Phoenix,

    It's been 3 weeks since we last heard from you. Are you still there? Is your problem solved?

    What's going on?
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

Posting Permissions

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