so close...trying get number of subfolders in a folder

[dnickelson]

Been grabbing several snippets and full macro's off the board trying to modify, but have been unable to find anything that will give me number of subfolders listed under a main folder.

I've tried so many I don't even know which to post to see if someone can modify, but all the code I've been finding seems to focus on returning files, names, paths etc. (a bunch from tushar which I needed and used as well)

I know if I could see it from the right point of view, or if I just hacked at the recursive piece long enough, I could grab the unique folders out of the results and get what I need, but short of pasting in half dozen random, half modified subs in here, anyone have a simple solution or re-starting point for me?

Thanks much,
-Dan

 

[Norie]

Dan

Do you actually want the number of subfolders?

Or do you want to do something with each folder?

 

[KenWright]

Googled and tweaked to let you select a starting folder - Dump this in a module and run the sub:-

Sub Countfolders()
Dim starthere As String
   starthere = PickFolder(strStartDir)
   If starthere = "" Then
      MsgBox "Canceled"
      Exit Sub
   End If
   MsgBox CountSubFolders(starthere)
End Sub


Function PickFolder(strStartDir As Variant) As String
  Dim SA As Object, F As Object
  Set SA = CreateObject("Shell.application")
  Set F = SA.BrowseForFolder(0, "Choose a folder", 0, strStartDir)
  If (Not F Is Nothing) Then
    PickFolder = F.items.Item.Path
  End If
  Set F = Nothing
  Set SA = Nothing
End Function


Function CountSubFolders(ByVal StartFolder As String) As Long
   Dim fso, F, f1, s, sf
   Dim lngCount As Long

   On Error GoTo ErrHandler

   Set fso = CreateObject("Scripting.FileSystemObject")

    If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"

   Set F = fso.GetFolder(StartFolder)
   Set sf = F.SubFolders
   lngCount = sf.Count
   For Each f1 In sf
      'Debug.Print StartFolder, f1.Name
       lngCount = lngCount + CountSubFolders(StartFolder & f1.Name)
   Next

ExitFunc:
   Set sf = Nothing
   Set F = Nothing
   Set fso = Nothing
   CountSubFolders = lngCount
   Exit Function

ErrHandler:
   'Do some error handling here
   Resume ExitFunc
End Function

 

[dnickelson]

Slick, this forum is the best. Just looking for the number of folders, already have all the coding i needed for the stuff inside. Ken's code shot out the number like there was nothing to it.

Have to sit and figure it out how it does it when I get a chance, but for now all i need to do is set it to run though the list of folders I'm keeping track of and I'm done. I forgot to mention that I was working with folders on a mapped network drive, which I'd had problems with with some of the other code, but it seems to work fine there as well.

Thanks a bunch guys.
-Dan