Ejemplo que utiliza la función del API SHBrowseForFolder y SHGetSpecialFolderLocation para selecionar uno de los ordenadores conectados a nuestra red.
Vista del cuadro de diálogo
Para desplegar el diálogo , llamar a la función " Buscar_Equipo_De_Red " y esta función luego retornará el nombre de la máquina seleccionada
Controles
Un CommandButton
Option Explicit
'Constantes
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
'Estructura BROWSEINFO necesaria para el Api SHBrowseForFolder
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
'Declaramos la función Api SHBrowseForForlder
Private Declare Function SHBrowseForFolder _
Lib "shell32.dll" _
Alias "SHBrowseForFolderA" ( _
lpBrowseInfo As BROWSEINFO) As Long
'Declaramos la función Api SHGetSpecialFolderLocation
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" ( _
ByVal hwndOwner As Long, _
ByVal nFolder As Long, _
pidl As Long) As Long
'Función que devuelve el nombre de la máquina
Private Function Buscar_Equipo_De_Red() As String
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
With BI
.hOwner = Me.hWnd
.pidlRoot = pidl
.pszDisplayName = Space$(MAX_PATH)
.lpszTitle = " Seleccionar el ordenador de la red de la lista :"
.ulFlags = BIF_BROWSEFORCOMPUTER
End With
' Esto abre el diálogo para buscar el equipo de red
If SHBrowseForFolder(BI) <> 0 Then
'retorna el valor a la función, es decir el nombre del equipo
Buscar_Equipo_De_Red = "\\" & Replace(BI.pszDisplayName, Chr(0), vbNullString)
End If
End If
End Function
Private Sub Command1_Click()
' Llama a la función que abre el cuadro de diálogo
Call Buscar_Equipo_De_Red
End Sub
Private Sub Form_Load()
Command1.Caption = " Buscar equipo de Red "
End Sub