To a project form add two command buttons (Command1, Command2), and two text boxes (Text1, Text2). Add the following code to the form: --------------------------------------------------------------------------------
Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Copyright ?1996-2003 VBnet, Randy Birch, All Rights Reserved. ' Some pages may also contain other copyrights by the author. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Distribution: You can freely use this code in your own ' applications, but you may not reproduce ' or publish this code on any web site, ' online service, or distribute as source ' on any media without express permission. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 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 = &H1000Private 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 TypePrivate Declare Function SHGetPathFromIDList Lib "shell32" _ Alias "SHGetPathFromIDListA" _ (ByVal pidl As Long, _ ByVal pszPath As String) As LongPrivate Declare Function SHBrowseForFolder Lib "shell32" _ Alias "SHBrowseForFolderA" _ (lpBrowseInfo As BROWSEINFO) As LongPrivate Declare Function SHGetSpecialFolderLocation Lib "shell32" _ (ByVal hwndOwner As Long, _ ByVal nFolder As Long, _ pidl As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32" _ (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 SHGetSpecialFolderLocationEnd 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
To a project form add two command buttons (Command1, Command2), and two text boxes (Text1, Text2). Add the following code to the form: --------------------------------------------------------------------------------
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ?1996-2003 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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 = &H1000Private 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 TypePrivate Declare Function SHGetPathFromIDList Lib "shell32" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As LongPrivate Declare Function SHBrowseForFolder Lib "shell32" _
Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As LongPrivate Declare Function SHGetSpecialFolderLocation Lib "shell32" _
(ByVal hwndOwner As Long, _
ByVal nFolder As Long, _
pidl As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32" _
(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 SHGetSpecialFolderLocationEnd 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
'--end block--'