Cuadro de diálogo buscar Equipo de Red

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