Bueno, estos códigos los he sacado para un proyecto en curso.
Devuelven un array con las subcarpetas de un servidor local.

OPCIÓN 1:

Option Explicit
'===========================================================================
' º Name        : GetSharedSubFolders
' º Author      : Psyke1
' º Mail        : vbpsyke1@mixmail.com
' º Explanation : Returns an array with the subfolders of a shared folder.
' º Date        : 26/11/12
' º Reference   : http://goo.gl/sgDVX
' º Greets      : LeandroA
' º Visit       :
'    * http://foro.h-sec.org
'    * http://infrangelux.sytes.net
'===========================================================================
 
Public Function getSharedSubFolders(ByVal sServer As String) As Collection
Dim oShell                  As Object
Dim oItem                   As Variant
 
    If PathIsNetworkPath(sServer) Then
       Set oShell = CreateObject("Shell.Application")
 
       If Not oShell.NameSpace(CVar(sServer)) Is Nothing Then
          Set getSharedSubFolders = New Collection
 
          For Each oItem In oShell.NameSpace(CVar(sServer)).Items
              getSharedSubFolders.Add oItem.Path
          Next oItem
       End If
    End If
End Function
 

Ejemplo de uso:

Private Sub Form_Load()
Dim vFolder                 As Variant
Dim cTmp                    As Collection
 
    Set cTmp = getSharedSubFolders("\\CARLOS-PC")
    If cTmp Is Nothing Then
        MsgBox "El servidor local no existe"
    Else
        For Each vFolder In cTmp
            Debug.Print vFolder
        Next
    End If
End Sub

---

OPCIÓN 2:

Option Explicit
'===========================================================================
' º Name        : mGetSharedSubFolders.bas
' º Author      : Psyke1
' º Mail        : vbpsyke1@mixmail.com
' º Explanation : Returns an array with the subfolders of a shared folder.
' º Date        : 26/11/12
' º Visit       :
'    * http://foro.h-sec.org
'    * http://infrangelux.sytes.net
'===========================================================================
 
'Type
Private Type NETRESOURCE
  dwScope       As Long
  dwType        As Long
  dwDisplayType As Long
  dwUsage       As Long
  lpLocalName   As Long
  lpRemoteName  As Long
  lpComment     As Long
  lpProvider    As Long
End Type
 
'kernel32.dll
Private Declare Function lstrlenA Lib "kernel32.dll" (ByVal pString As Long) As Long
Private Declare Function lstrcpyA Lib "kernel32.dll" (ByVal lpString1 As String, ByVal pString As Long) As Long
 
'mpr.dll
Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As NETRESOURCE, lphEnum As Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, lpBuffer As NETRESOURCE, lpBufferSize As Long) As Long
 
'shlwapi.dll
Private Declare Function PathIsNetworkPath Lib "shlwapi.dll" Alias "PathIsNetworkPathA" (ByVal pszPath As String) As Long
 
'Consts
Private Const RESOURCE_GLOBALNET        As Long = &H2
Private Const RESOURCETYPE_DISK         As Long = &H1
Private Const MAX_RESOURCES             As Long = &H100
 
'Function
Public Function getShareSubFolders(ByVal sNameServer As String) As String()
Dim hEnum                               As Long
Dim lLen                                As Long
Dim lTotal                              As Long
Dim lpRName                             As Long
Dim sRet()                              As String
Dim tNet(0 To MAX_RESOURCES)            As NETRESOURCE
 
    If PathIsNetworkPath(sNameServer) Then
        lTotal = -1
        lLen = &H1000 '(UBound(tNet) * Len(tNet(0))) / 2
 
        tNet(0).lpRemoteName = StrPtr(StrConv(sNameServer, vbFromUnicode))
 
        If Not WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0, tNet(0), hEnum) Then
            If Not WNetEnumResource(hEnum, lTotal, tNet(0), lLen) Then
                If lTotal > 0 Then
                    lTotal = lTotal - 1
                    ReDim sRet(0 To lTotal) As String
 
                    For lLen = 0 To lTotal
                        lpRName = tNet(lLen).lpRemoteName
 
                        sRet(lLen) = Space(lstrlenA(lpRName))
                        lstrcpyA sRet(lLen), lpRName
                    Next lLen
                End If
            End If
 
            WNetCloseEnum hEnum
        End If
    End If
 
    getShareSubFolders = sRet()
End Function

Ejemplo de uso:

Private Sub Form_Load()
Dim vSubFolder                          As Variant
Dim sSF()                               As String
 
    sSF = getShareSubFolders("\\CARLOS-PC")
 
    If Not Not sSF Then
 
        For Each vSubFolder In sSF
            Debug.Print vSubFolder
        Next vSubFolder
    End If
 
    'fix NotNot hack :)
    Debug.Assert App.hInstance
End Sub

DoEvents!

Me ha dado dolores de cabeza porque hay muy poca documentación.
La idea de la primera función fue de LeandroA... (tiene solución para todo)

DoEvents!