Compress subfolders of a folder

This function compresses all subfolders and all files in those subfolders. The drive must be NTFS for this to work

Code:

---

Public Function CompressSubFolders(ByVal Path As String) As Boolean
    Dim objFolder As Object, objWMI As Object, strWQL As String
    On Error GoTo ErrorHandler
    Set objWMI = GetObject("winmgmts:\\.\root\CIMV2")
    strWQL = "ASSOCIATORS OF {Win32_Directory.Name=""" & Replace(Path, "\", "\\") & """} WHERE AssocClass = Win32_Subdirectory ResultRole = PartComponent"
    For Each objFolder In objWMI.ExecQuery(strWQL, , 48)
        CompressSubFolders = CompressSubFolders Or (objWMI.ExecMethod("Win32_Directory.Name=""" & Replace(objFolder.Name, "\", "\\") & """", "Compress", Nothing).ReturnValue = 0)
    Next
ErrorHandler:
End Function

---

Returns True if compressing any of the subfolders succeeded. Note that this function may lock your application for a while if used on a big folder.