delete folders on search

[Phoenix23]

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

[Sebastian H]

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/12/08/introduction-to-regular-expressions-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.

[SamT]

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

[Sebastian H]

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?

[snb]

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.

[SamT]

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

[Sebastian H]

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.

[snb]

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"

[SamT]

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

[Paul_Hossler]

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

[SamT]

Phoenix,

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

What's going on?