Seleccionar equipos y carpetas de una red Windows

Option Explicit On
Private Const ERROR_SUCCESS As Long = 0
Private Const MAX_PATH As Long = 260
Private Const CSIDL_NETWORK As Long = &H12
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000

Private Type BROWSEINFO
   hOwner As Long
   pidlRoot As Long
   pszDisplayName As String
   lpszTitle As String
   ulFlags As Long
   lpfn As Long
   lParam As Long
   iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
   Alias "SHGetPathFromIDListA" _
  (ByVal pidl As Long, _
   ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
   Alias "SHBrowseForFolderA" _
  (ByVal lpBrowseInfo As BROWSEINFO) As Long

Private Declare Function SHGetSpecialFolderLocation _
   Lib "shell32.dll" _
  (ByVal hwndOwner As Long, _
   ByVal nFolder As Long, _
   ByVal pidl As Long) As Long

Private Declare Sub CoTaskMemFree Lib "ole32.dll" _
   (ByVal pv As Long)
Private Sub Command1_Click()
    Text1.Text = GetBrowseNetworkWorkstation()
End Sub
Private Sub Command2_Click()
    Text2.Text = GetBrowseNetworkShare()
End Sub
Private Function GetBrowseNetworkShare() As String
    'returns only a valid share on a
    'network server or workstation
    Dim BI As BROWSEINFO
    Dim pidl As Long
    Dim sPath As String
    Dim pos As Integer

    'obtain the pidl to the special folder 'network'
    If SHGetSpecialFolderLocation(Me.hWnd, _
                                 CSIDL_NETWORK, _
                                 pidl) = ERROR_SUCCESS Then

        'fill in the required members, limiting the
        'Browse to the network by specifying the
        'returned pidl as pidlRoot
        With BI
            .hOwner = Me.hWnd
            .pidlRoot = pidl
            .pszDisplayName = Space$(MAX_PATH)
            .lpszTitle = "Select a network computer or share."
            .ulFlags = BIF_RETURNONLYFSDIRS
        End With

        'show the browse dialog
        pidl = SHBrowseForFolder(BI)
        If pidl <> 0 Then
            'got a pidl .. but is it valid?
            sPath = Space$(MAX_PATH)
            If SHGetPathFromIDList(ByVal pidl, ByVal sPath) Then
                'valid, so get the share path
                pos = InStr(sPath, Chr$(0))
                GetBrowseNetworkShare = Left$(sPath, pos - 1)
            End If
            Call CoTaskMemFree(pidl)
        Else
            'a server selected...follow same principle
            'as in GetBrowseNetworkWorkstation
            GetBrowseNetworkShare = "\" & BI.pszDisplayName
        End If  'If pidl
    End If  'If SHGetSpecialFolderLocation
End Function
Private Function GetBrowseNetworkWorkstation() As String
    'returns only a valid network server or
    'workstation (does not display the shares)
    Dim BI As BROWSEINFO
    Dim pidl As Long
    Dim sPath As String
    Dim pos As Integer

    'obtain the pidl to the special folder 'network'
    If SHGetSpecialFolderLocation(Me.hWnd, _
                                 CSIDL_NETWORK, _
                                 pidl) = ERROR_SUCCESS Then

        'fill in the required members, limiting the
        'Browse to the network by specifying the
        'returned pidl as pidlRoot
        With BI
            .hOwner = Me.hWnd
            .pidlRoot = pidl
            .pszDisplayName = Space$(MAX_PATH)
            .lpszTitle = "Select a network computer."
            .ulFlags = BIF_BROWSEFORCOMPUTER
        End With

        'show the browse dialog. We don't need
        'a pidl, so it can be used in the If..then directly.
        If SHBrowseForFolder(BI) <> 0 Then
            'a server was selected. Although a valid pidl
            'is returned, SHGetPathFromIDList only return
            'paths to valid file system objects, of which
            'a networked machine is not. However, the
            'BROWSEINFO displayname member does contain
            'the selected item, which we return
            GetBrowseNetworkWorkstation = "\" & BI.pszDisplayName
        End If  'If SHBrowseForFolder
        Call CoTaskMemFree(pidl)
    End If  'If SHGetSpecialFolderLocation
End Function