
Podemos usar la función del API SHBrowseForFolder para selecionar uno de los ordenadores o recursos compartidos de nuestra red.
Para ello declaramos :
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 'BI
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" _
(lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetSpecialFolderLocation _
Lib "shell32.dll" _
(ByVal hwndOwner As Long, _
ByVal nFolder As Long, _
pidl As Long) As Long
Emplearemos esta función auxiliar para tratar las cadenas devueltas por el API :
Function AsciiZ(texto As String) As String
'esta función se utiliza para devolver la parte del string
'hasta el primer chr(0). Las funciones del API suelen emplear
'un chr(0) para marcar el final de las cadenas de texto
Dim i As Long
i = InStr(texto, Chr(0))
If i = 0 Then
AsciiZ = texto
Else
AsciiZ = Left(texto, i - 1)
End If
End Function
Y luego esta función nos devolverá un nombre de máquina o de recurso compartido en notación UNC (\\NombreOrdenador\NombreRecurso) :
Private Function BrowseForShares() As String
'mostrar sólo ordenadores y recursos compartidos
Dim BI As BROWSEINFO
Dim pidl As Long
Dim sPath As String
Dim pos As Integer
'obtener el pidl de la carpeta 'Entorno de red'
If SHGetSpecialFolderLocation(Me.hWnd, CSIDL_NETWORK, pidl) = ERROR_SUCCESS Then
'rellenar la estructura limitando a ordenadores especificando
'el pidl devuelto como pidl raíz
With BI
.hOwner = Me.hWnd
.pidlRoot = pidl
.pszDisplayName = Space$(MAX_PATH)
.lpszTitle = "Seleccione un ordenador o un recurso compartido :"
.ulFlags = BIF_RETURNONLYFSDIRS
End With
'mostrar el diálogo de búsqueda
pidl = SHBrowseForFolder(BI)
If pidl <> 0 Then
'comprobar que es un pidl válido
sPath = Space$(MAX_PATH)
If SHGetPathFromIDList(ByVal pidl, ByVal sPath) Then
'es válido, se trata de un recurso compartido
BrowseForShares = AsciiZ(sPath)
Else
'se ha seleccionado un ordenador
BrowseForShares = "\\" & AsciiZ(BI.pszDisplayName)
End If
End If
End If
End Function

