Here is a recursive procedure that enumerates all of the network resources. Create a from and drop in a command button (cmdGetNetwork) and a ListBox (lstResources).
You will need to control how many levels deep within the recursion you want to go in order to get the granularity of resources that you wish
'========================================================
Option Explicit
'--------------------------------------------------------
Private Const MAX_RESOURCES As Long = 256
Private Const NOT_A_CONTAINER As Long = -1
Private Const RESOURCE_GLOBALNET As Long = &H2&
Private Const RESOURCETYPE_ANY As Long = &H0&
Private Const RESOURCEUSAGE_ALL As Long = &H0&
Private Const SUCCESS As Long = 0&
Private Const RESOURCE_ENUM_ALL As Long = &HFFFF
Private Type NETRESOURCE
tLng_Scope As Long
tLng_Type As Long
tLng_DisplayType As Long
tLng_Usage As Long
tLng_LocalName As Long
tLng_RemoteName As Long
tLng_Comment As Long
tLng_Provider As Long
End Type
'--------------------------------------------------------
Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" _
(ByVal dwScope As Long, ByVal dwType As Long, _
ByVal dwUsage As Long, lpNetResource As Any, _
lppEnumHwnd As Long) _
As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" _
(ByVal pEnumHwnd As Long, lpcCount As Long, _
lpBuffer As NETRESOURCE, lpBufferSize As Long) _
As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" _
(ByVal lLng_EnumHand As Long) _
As Long
Private Declare Function StrLenA Lib "kernel32" Alias "lstrlenA" _
(ByVal Ptr As Long) _
As Long
Private Declare Function StrCopyA Lib "kernel32" Alias "lstrcpyA" _
(ByVal RetVal As String, ByVal Ptr As Long) _
As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" _
(pTo As Any, uFrom As Any, ByVal lSize As Long)
'========================================================
Private Sub cmdGetNetwork_Click()
cmdGetNetwork.Enabled = False
DoEvents
ShowResources
cmdGetNetwork.Enabled = True
DoEvents
End Sub
'========================================================
Private Sub ShowResources()
Dim lLng_RetVal As Long
Dim lLng_EnumHand As Long
Dim lLng_Count As Long
Dim lInt_Idx As Long
Dim lLng_BuffSize As Long
Dim lNet_Resource(MAX_RESOURCES) As NETRESOURCE
lLng_EnumHand = 0&
lLng_RetVal = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, ByVal 0&, lLng_EnumHand)
If (lLng_RetVal = SUCCESS) Then
lLng_Count = RESOURCE_ENUM_ALL
lLng_BuffSize = UBound(lNet_Resource) * Len(lNet_Resource(0))
lLng_RetVal = WNetEnumResource(lLng_EnumHand, lLng_Count, lNet_Resource(0), lLng_BuffSize)
If (lLng_Count > 0) Then
For lInt_Idx = 0 To lLng_Count - 1
lstResources.AddItem (PointerToAsciiStr(lNet_Resource(lInt_Idx).tLng_RemoteName))
DoEvents
ShowResourcesThisItem lNet_Resource(lInt_Idx), ""
Next lInt_Idx
End If
End If
If (lLng_EnumHand <> 0) Then
Call WNetCloseEnum(lLng_EnumHand)
End If
End Sub
'--------------------------------------------------------
Private Sub ShowResourcesThisItem(rNet_Resource As NETRESOURCE, rStr_Spacer As String)
Dim lLng_RetVal As Long
Dim lLng_EnumHand As Long
Dim lLng_Count As Long
Dim lInt_Idx As Long
Dim lLng_BuffSize As Long
Dim lNet_Resource(MAX_RESOURCES) As NETRESOURCE
lLng_RetVal = WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, rNet_Resource, lLng_EnumHand)
If (lLng_RetVal = SUCCESS) Then
lLng_Count = RESOURCE_ENUM_ALL
lLng_BuffSize = UBound(lNet_Resource) * Len(lNet_Resource(0))
lLng_RetVal = WNetEnumResource(lLng_EnumHand, lLng_Count, lNet_Resource(0), lLng_BuffSize)
If (lLng_Count > 0) Then
For lInt_Idx = 0 To lLng_Count - 1
lstResources.AddItem rStr_Spacer & (PointerToAsciiStr(lNet_Resource(lInt_Idx).tLng_RemoteName))
DoEvents
ShowResourcesThisItem lNet_Resource(lInt_Idx), (rStr_Spacer & Space(3))
Next lInt_Idx
End If
End If
If (lLng_EnumHand <> 0) Then
Call WNetCloseEnum(lLng_EnumHand)
End If
End Sub
'--------------------------------------------------------
Public Function PointerToAsciiStr(ByVal vLng_StringPtr As Long) As String
Dim lLng_StrLen As Long
Dim lStr_StrValue As String
Dim lLng_NullPos As Long
Dim lLng_RetVal As Long
Dim lStr_ReturnString As String
lLng_StrLen = StrLenA(vLng_StringPtr)
If vLng_StringPtr > 0 And lLng_StrLen > 0 Then
lStr_StrValue = Space$(lLng_StrLen + 1)
lLng_RetVal = StrCopyA(lStr_StrValue, vLng_StringPtr)
lLng_NullPos = InStr(lStr_StrValue, Chr$(0))
If (lLng_NullPos > 0) Then
lStr_ReturnString = Left(lStr_StrValue, (lLng_NullPos - 1))
Else
lStr_ReturnString = lStr_StrValue
End If
Else
lStr_ReturnString = ""
End If
PointerToAsciiStr = lStr_ReturnString
End Function
'========================================================
Good Luck
--------------
As a circle of light increases so does the circumference of darkness around it. - Albert Einstein