Как добавить, что подсчитывает папку, которая имеет наибольшее количество папок и выводит ее имя?

Question

Я бы хотел, чтобы этот скрипт подсчитывал количество подпапок папок на первом уровне и выводил имя папки, которая имеет большее количество подпапок.

Здесьэто базовый код:

Dim NOME_CARTELLA_SELEZIONATA,nomedrive
Dim SHELLA, OGGETTO_FOLDER
Set SHELLA  = CreateObject( "Shell.Application" )
nomedrive = "C:\"
Set OGGETTO_FOLDER = SHELLA.BrowseForFolder( 0, "SELEZIONA UNA CARTELLA", 0, nomedrive)
If Not (OGGETTO_FOLDER Is Nothing) Then
    NOME_CARTELLA_SELEZIONATA = OGGETTO_FOLDER.Self.Path
    Set OGGETTO_FOLDER = Nothing
Else
    NOME_CARTELLA_SELEZIONATA = ""
End If
Set SHELLA = Nothing
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(NOME_CARTELLA_SELEZIONATA)
ShowSubFolders objFSO.GetFolder(NOME_CARTELLA_SELEZIONATA)

Sub ShowSubFolders(Folder)
    For Each Subfolder In Folder.SubFolders
        WScript.Echo Subfolder.Path
        Set objFolder = objFSO.GetFolder(Subfolder.Path)
        Set colFiles = objFolder.Files
        ShowSubFolders Subfolder
    Next
End Sub