BrowseForFolder with default path

If I specify a folder (DefFld) and the folder exist
now I con not browse outside that folder.

Why?


; Example: (ALE_BrowseForFolder "Select a folder:" "C:\\Temp\\")
;
; Credits: Tony Tanzillo
;
(defun ALE_BrowseForFolder (PrmStr DefFld / ShlObj Folder FldObj OutVal)
(vl-load-com)
(setq
ShlObj (vla-getInterfaceObject
(vlax-get-acad-object) "Shell.Application"
)
Folder (vlax-invoke-method ShlObj
'BrowseForFolder 0 PrmStr 50 DefFld
)
)
(vlax-release-object ShlObj)
(if Folder
(progn
(setq
FldObj (vlax-get-property Folder 'Self)
OutVal (vlax-get-property FldObj 'Path)
)
(vlax-release-object Folder)
(vlax-release-object FldObj)
OutVal
)
)
)
;
; BrowseForFolder Method
;------------------------------------------------------------------
;
; Creates a dialog box that enables the user to select a folder and
; then returns the selected folder's Folder object.
;
; Syntax
;
; oFolder =
; Shell.BrowseForFolder(Hwnd, sTitle, iOptions [, vRootFolder])
;
; Parameters
;
; Hwnd Required. The handle to the parent window of the dialog box.
; This value can be zero.
;
; sTitle Required. A String value that represents the title
; displayed inside the Browse dialog box.
;
; iOptions Required. An Integer value that contains the options for
; the method. This can be zero or a combination of the values listed
; under the ulFlags member of the BROWSEINFO structure.
;
; vRootFolder Optional. Specifies a root folder for use in the
; dialog box. The user cannot browse higher in the tree than this
; folder. If this value is not specified, the root folder used in
; the dialog box is the desktop. This value can be a string that
; specifies the path of the folder or one of the
; ShellSpecialFolderConstants values. Note that the constant names
; found in ShellSpecialFolderConstants are available in Microsoft
; Visual Basic, but not in Visual Basic Scripting Edition (VBScript)
; or Microsoft JScript. In those cases, the numeric values must be
; used in their place.
;
; Return Value
;
; An object reference to the selected folder's Folder object.
;
; Examples
;
; The following example uses BrowseForFolder to display a browse
; window titled "Example" rooted at the Windows folder. Proper usage
; is shown for JScript, VBScript, and Visual Basic.
;
;
; <script language="VBScript">
; function fnShellBrowseForFolderVB()
; dim objShell
; dim ssfWINDOWS
; dim objFolder
; ssfWINDOWS = 36
; set objShell = CreateObject("Shell.Application")
; set objFolder = objShell.BrowseForFolder(0, "Example", 0,
ssfWINDOWS)
; if (not objFolder is nothing) then
; 'Add code here.
; end if
; set objFolder = nothing
; set objShell = nothing
; end function
; </script>
;
; Visual Basic:
; Private Sub fnShellBrowseForFolderVB()
; Dim objShell As Shell
; Dim ssfWINDOWS As Long
; Dim objFolder As Folder
; ssfWINDOWS = 36
; Set objShell = New Shell
; Set objFolder = objShell.BrowseForFolder(0, "Example", 0,
ssfWINDOWS)
; If (Not objFolder Is Nothing) Then
; 'Add code here
; End If
; Set objFolder = Nothing
; Set objShell = Nothing
; End Sub
;
; Method Information
;
; Minimum DLL version shell32.dll version 4.71 or later
; Minimum operating systems Windows 2000, Windows NT 4.0 with
; Internet Explorer 4.0, Windows 98, Windows 95 with Internet
; Explorer 4.0


--

Marc'Antonio Alessi
http://xoomer.virgilio.it/alessi
(strcat "NOT a " (substr (ver) 8 4) " guru.")

--

 

Hi Marc'Antonio

You find the answer here:

A while back, I've found the following (VB) sample from Randy Birch:

Code:

================================================================================
Prerequisites
Windows' Browse for Folders dialog provides the means to retrieve from a user
their selection of the Shell's file system and special folders. This page
discusses adding the callback functionality necessary to a VB5 application in
order to to provide the ability to pre-select a folder on the dialog's display.

Once again, VBnet is pleased to present methods developed by Brad Martinez
(http://www.mvps.org/btmtz/), author of the Browse for Folders routines
presented on this site, as well as author of the Common Controls Replacement
Project BrowseDialog control.

May 30 1999:
Significant changes to the code have been made to allow use of the PIDL method
(BrowseForFolderByPIDL function) on all windows platforms. In addition, since
paths supplied to the API need to have its trailing slash removed, a routine
was added to do just that.

Feb 7 2004:
The pre-selection string passed to the Browse function and used in the Browse
method's LocalAlloc and CopyMemory calls _must_ not be empty, otherwise an
error will occur. The code was modified to include a new function - FixPath -
that ensures the string is not empty and is properly formatted based on the
type of file system identifier passed. I strongly recommend FixPath()
be _always_ called prior to attempting to pass a string representing a path in
to any Browse routine.

Remember as well that the path returned from the BrowseForFolders call will
have a trailing space if the selected path is a drive, or without a trailing
space if the selected path is a file system folder. Therefore, an additional
call to QualifyPath() may be required to properly format it before appending
filenames or folders to the return result.

--------------------------------------------------------------------------------
BAS Module Code
Add the following code to a BAS module:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2004 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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'common to both methods
Public 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

Public Declare Function SHBrowseForFolder Lib "shell32" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

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

Public Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDest As Any, pSource As Any, ByVal dwLength As Long)

Public Const MAX_PATH = 260
Public Const WM_USER = &H400
Public Const BFFM_INITIALIZED = 1

'Constants ending in 'A' are for Win95 ANSI
'calls; those ending in 'W' are the wide Unicode
'calls for NT.

'Sets the status text to the null-terminated
'string specified by the lParam parameter.
'wParam is ignored and should be set to 0.
Public Const BFFM_SETSTATUSTEXTA As Long = (WM_USER + 100)
Public Const BFFM_SETSTATUSTEXTW As Long = (WM_USER + 104)

'If the lParam  parameter is non-zero, enables the
'OK button, or disables it if lParam is zero.
'(docs erroneously said wParam!)
'wParam is ignored and should be set to 0.
Public Const BFFM_ENABLEOK As Long = (WM_USER + 101)

'Selects the specified folder. If the wParam
'parameter is FALSE, the lParam parameter is the
'PIDL of the folder to select , or it is the path
'of the folder if wParam is the C value TRUE (or 1).
'Note that after this message is sent, the browse
'dialog receives a subsequent BFFM_SELECTIONCHANGED
'message.
Public Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Public Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)

'specific to the PIDL method
'Undocumented call for the example. IShellFolder's
'ParseDisplayName member function should be used instead.
Public Declare Function SHSimpleIDListFromPath Lib _
"shell32" Alias "#162" (ByVal szPath As String) As Long

'specific to the STRING method
Public Declare Function LocalAlloc Lib "kernel32" _
(ByVal uFlags As Long, ByVal uBytes As Long) As Long

Public Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long

Public Declare Function lstrcpyA Lib "kernel32" _
(lpString1 As Any, lpString2 As Any) As Long

Public Declare Function lstrlenA Lib "kernel32" (lpString As Any) As Long

Public Const LMEM_FIXED = &H0
Public Const LMEM_ZEROINIT = &H40
Public Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)

'windows-defined type OSVERSIONINFO
Public Type OSVERSIONINFO
OSVSize         As Long
dwVerMajor      As Long
dwVerMinor      As Long
dwBuildNumber   As Long
PlatformID      As Long
szCSDVersion    As String * 128
End Type

Public Const VER_PLATFORM_WIN32_NT = 2

Public Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Public Declare Function GetLogicalDriveStrings Lib "kernel32" _
Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long


Public Function BrowseCallbackProcStr(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal lParam As Long, _
ByVal lpData As Long) As Long

'Callback for the Browse STRING method.
'On initialization, set the dialog's
'pre-selected folder from the pointer
'to the path allocated as bi.lParam,
'passed back to the callback as lpData param.

Select Case uMsg
Case BFFM_INITIALIZED
Call SendMessage(hWnd, BFFM_SETSELECTIONA, True, ByVal lpData)
Case Else:
End Select

End Function


Public Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal lParam As Long, _
ByVal lpData As Long) As Long

'Callback for the Browse PIDL method.
'On initialization, set the dialog's
'pre-selected folder using the pidl
'set as the bi.lParam, and passed back
'to the callback as lpData param.
Select Case uMsg
Case BFFM_INITIALIZED
Call SendMessage(hWnd, BFFM_SETSELECTIONA, False, ByVal lpData)
Case Else:
End Select

End Function


Public Function FARPROC(pfn As Long) As Long

'A dummy procedure that receives and returns
'the value of the AddressOf operator.
'This workaround is needed as you can't
'assign AddressOf directly to a member of a
'user-defined type, but you can assign it
'to another long and use that instead!
FARPROC = pfn

End Function

--------------------------------------------------------------------------------
Form Code :

In order to keep the two Browse methods from looking more complicated than they
really are the calls in the code below have Brad's commenting removed.  The same
code - fully-commented - is provided in the Comments section so you understand
what's going on. To create this project, add to a form two command buttons
(Command1, Command2), and two text boxes (Text1, Text2).  Add the following code
to the form:

Option Explicit

Private Sub Form_Load()

Command1.Caption = "Browse using folder name"
Command2.Caption = "Browse using folder pidl"

'a default start point
Text1.Text = "C:\"

End Sub


Private Sub Command1_Click()

Dim spath As String

'the path used in the Browse function
'must be correctly formatted depending
'on whether the path is a drive, a
'folder, or "".
spath = FixPath(Text1.Text)

'call the function, returning the path
'selected (or "" if cancelled)
Text2.Text = BrowseForFolderByPath(spath)

End Sub


Private Sub Command2_Click()

Dim spath As String

spath = FixPath(Text1.Text)
Text2.Text = BrowseForFolderByPIDL(spath)

End Sub


Private Function BrowseForFolderByPath(sSelPath As String) As String

Dim BI As BROWSEINFO
Dim pidl As Long
Dim lpSelPath As Long
Dim sPath As String * MAX_PATH

With BI
.hOwner = Me.hWnd
.pidlRoot = 0
.lpszTitle = "Pre-selecting folder using the folder's string."
.lpfn = FARPROC(AddressOf BrowseCallbackProcStr)

lpSelPath = LocalAlloc(LPTR, Len(sSelPath) + 1)
CopyMemory ByVal lpSelPath, ByVal sSelPath, Len(sSelPath) + 1
.lParam = lpSelPath

End With

pidl = SHBrowseForFolder(BI)

If pidl Then

If SHGetPathFromIDList(pidl, sPath) Then
BrowseForFolderByPath = Left$(sPath, InStr(sPath, vbNullChar) - 1)
Else
BrowseForFolderByPath = ""
End If

Call CoTaskMemFree(pidl)

Else
BrowseForFolderByPath = ""
End If

Call LocalFree(lpSelPath)

End Function


Private Function BrowseForFolderByPIDL(sSelPath As String) As String

Dim BI As BROWSEINFO
Dim pidl As Long
Dim sPath As String * MAX_PATH

With BI
.hOwner = Me.hWnd
.pidlRoot = 0
.lpszTitle = "Pre-selecting a folder using the folder's pidl."
.lpfn = FARPROC(AddressOf BrowseCallbackProc)
.lParam = GetPIDLFromPath(sSelPath)
End With

pidl = SHBrowseForFolder(BI)

If pidl Then
If SHGetPathFromIDList(pidl, sPath) Then
BrowseForFolderByPIDL = Left$(sPath, InStr(sPath, vbNullChar) - 1)
Else
BrowseForFolderByPIDL = ""
End If

'free the pidl from SHBrowseForFolder call
Call CoTaskMemFree(pidl)
Else
BrowseForFolderByPIDL = ""
End If

'free the pidl (lparam) from GetPIDLFromPath call
Call CoTaskMemFree(BI.lParam)

End Function


Private Function GetPIDLFromPath(spath As String) As Long

'return the pidl to the path supplied by calling the
'undocumented API #162 (our name for this undocumented
'function is "SHSimpleIDListFromPath").
'This function is necessary as, unlike documented APIs,
'the API is not implemented in 'A' or 'W' versions.

If IsWinNT() Then
GetPIDLFromPath = SHSimpleIDListFromPath(StrConv(spath, vbUnicode))
Else
GetPIDLFromPath = SHSimpleIDListFromPath(spath)
End If

End Function


Private Function IsWinNT() As Boolean

#If Win32 Then

Dim OSV As OSVERSIONINFO

OSV.OSVSize = Len(OSV)

'API returns 1 if a successful call
If GetVersionEx(OSV) = 1 Then

'PlatformId contains a value representing
'the OS; if VER_PLATFORM_WIN32_NT,
'return true
IsWinNT = OSV.PlatformID = VER_PLATFORM_WIN32_NT
End If

#End If

End Function


Private Function IsValidDrive(sPath As String) As String

Dim buff As String
Dim nBuffsize As Long

'Call the API with a buffer size of 0.
'The call fails, and the required size
'is returned as the result.
nBuffsize = GetLogicalDriveStrings(0&, buff)

'pad a buffer to hold the results
buff = Space$(nBuffsize)
nBuffsize = Len(buff)

'and call again
If GetLogicalDriveStrings(nBuffsize, buff) Then

'if the drive letter passed is in
'the returned logical drive string,
'return True.
IsValidDrive = InStr(1, buff, sPath, vbTextCompare)

End If

End Function


Private Function FixPath(sPath As String) As String

'The Browse callback requires the path string
'in a specific format - trailing slash if a
'drive only, or minus a trailing slash if a
'file system path. This routine assures the
'string is formatted correctly.
'
'In addition, because the calls to LocalAlloc
'requires a valid path for the call to succeed,
'the path defaults to C:\ if the passed string
'is empty.

'Test 1: check for empty string. Since
'we're setting it we can assure it is
'formatted correctly, so can bail.
If Len(sPath) = 0 Then
FixPath = "C:\"
Exit Function
End If

'Test 2: is path a valid drive?
'If this far we did not set the path,
'so need further tests. Here we ensure
'the path is properly terminated with
'a trailing slash as needed.
'
'Drives alone require the trailing slash;
'file system paths must have it removed.
If IsValidDrive(sPath) Then

'IsValidDrive only determines if the
'path provided is contained in
'GetLogicalDriveStrings. Since
'IsValidDrive() will return True
'if either C: or C:\ is passed, we
'need to ensure the string is formatted
'with the trailing slash.
FixPath = QualifyPath(sPath)
Else
'The string passed was not a drive, so
'assume it's a path and ensure it does
'not have a trailing space.
FixPath = UnqualifyPath(sPath)
End If

End Function


Private Function QualifyPath(sPath As String) As String

If Len(sPath) > 0 Then
If Right$(sPath, 1) <> "\" Then
QualifyPath = sPath & "\"
Else
QualifyPath = sPath
End If
Else
QualifyPath = ""
End If

End Function


Private Function UnqualifyPath(spath As String) As String

'Qualifying a path involves assuring that its format
'is valid, including a trailing slash, ready for a
'filename. Since SHBrowseForFolder will not pre-select
'the path if it contains the trailing slash, it must be
'removed, hence 'unqualifying' the path.
If Len(spath) > 0 Then
If Right$(spath, 1) = "\" Then
UnqualifyPath = Left$(spath, Len(spath) - 1)
Exit Function
End If
End If

UnqualifyPath = spath

End Function

--------------------------------------------------------------------------------
Comments
Save then run the project. Change the path in Text1 to a suitable path on your
system, and press either of the two Browse command buttons. The Browse dialog
should appear with the path you indicated selected. As explanation of the
members and calls made in the different browse calls above, the following is the
the same code with comments.

Private Function BrowseForFolderByPIDL(sSelPath As String) As String

Dim BI As BROWSEINFO
Dim pidl As Long
Dim sPath As String * MAX_PATH

With BI
'owner of the dialog. Pass 0 for the desktop.
.hOwner = Me.hWnd

'The desktop folder will be the dialog's
'root folder. SHSimpleIDListFromPath return
'values can also be used to set this. This
'member determines the 'root' point of the
'Browse display.
.pidlRoot = 0

'Set the dialog's prompt string, if desired
.lpszTitle = "Pre-selecting a folder using the folder's pidl."

'Obtain and set the address of the callback
'function. We need this workaround as you can't
'assign the AddressOf directly to a member of
'a user-defined type, but you can set assign it
'to another long and use that (as returned in
'the FARPROC call!!)
.lpfn = FARPROC(AddressOf BrowseCallbackProc)

'Obtain and set the pidl of the pre-selected folder
.lParam = GetPIDLFromPath(sSelPath)
End With

'Shows the browse dialog and doesn't return until the
'dialog is closed. The BrowseCallbackProc below will
'receive all browse dialog specific messages while
'the dialog is open. pidl will contain the pidl of
'the selected folder if the dialog is not cancelled.
pidl = SHBrowseForFolder(BI)

If pidl Then

'Get the path from the selected folder's pidl returned
'from the SHBrowseForFolder call. Returns True on success.
'Note: sPath must be pre-allocated!)
If SHGetPathFromIDList(pidl, sPath) Then

'return the path
BrowseForFolderByPIDL = Left$(sPath, InStr(sPath, vbNullChar) - 1)

Else

'No pidl was returned, indicating a problem,
'so the demo returns a blank string. In practice
'you may want to instead default the failure to
'return "C:\" to allow the app to continue.
BrowseForFolderByPIDL = ""

End If

'Free the memory allocated for the pidl
Call CoTaskMemFree(pidl)

End If

'free the memory allocated for
'the pre-selected folder
Call CoTaskMemFree(BI.lParam)

End Function


Private Function BrowseForFolderByPath(sSelPath As String) As String

Dim BI As BROWSEINFO
Dim pidl As Long
Dim lpSelPath As Long
Dim sPath As String * MAX_PATH

With BI
'owner of the dialog. Pass 0 for the desktop.
.hOwner = Me.hWnd

'The desktop folder will be the dialog's root folder.
'SHSimpleIDListFromPath can also be used to set this value.
.pidlRoot = 0

'Set the dialog's prompt string
.lpszTitle = "Pre-selecting the folder using the folder's string."

'Obtain and set the address of the callback function
.lpfn = FARPROC(AddressOf BrowseCallbackProcStr)

'Now the fun part. Allocate some memory for the dialog's
'selected folder path (sSelPath), blast the string into
'the allocated memory, and set the value of the returned
'pointer to lParam (checking LocalAlloc's success is
'omitted for brevity). Note: VB's StrPtr function won't
'work here because a variable's memory address goes out
'of scope when passed to SHBrowseForFolder.
'
'Note: Win2000 requires that the memory block
'include extra space for the string's terminating null.
lpSelPath = LocalAlloc(LPTR, Len(sSelPath) + 1)
CopyMemory ByVal lpSelPath, ByVal sSelPath, Len(sSelPath) + 1
.lParam = lpSelPath

End With

'Shows the browse dialog and doesn't return until the
'dialog is closed. The BrowseCallbackProcStr will
'receive all browse dialog specific messages while
'the dialog is open. pidl will contain the pidl of the
'selected folder if the dialog is not cancelled.
pidl = SHBrowseForFolder(BI)

If pidl Then

'Get the path from the selected folder's pidl returned
'from the SHBrowseForFolder call (rtns True on success,
'sPath must be pre-allocated!)

If SHGetPathFromIDList(pidl, sPath) Then

'Return the path
BrowseForFolderByPath = Left$(sPath, InStr(sPath, vbNullChar) - 1)

Else

'No pidl was returned, indicating a problem,
'so the demo returns a blank string. In practice
'you may want to instead default the failure to
'return "C:\" to allow the app to continue.
BrowseForFolderByPath = ""

End If

'Free the memory allocated for the pidl.
Call CoTaskMemFree(pidl)

End If

'Free the allocated pointer
Call LocalFree(lpSelPath)

End Function

================================================================================
Prerequisites
To test, a network connection or shared folders on the local system.

Amongst the Browse dialog's uFlags options is the ability to specify
BIF_BROWSEFORCOMPUTER to only return computers. If the user selects anything
other than a computer, the OK button is greyed. But this method has its problems
- the user can only select servers or workstations, not the shares they contain.
In addition, although a valid pidl (pointer to an item ID list) is returned, the
server can not be retrieved using this pidl in a call to SHGetPathFromIDList
because a server is not a valid file system object.
This page presents two workarounds to this limitation providing two wrapper
functions that return either the share name in the familiar \\serverX format, or
the full path to the share (i.e. \\serverX\projects\files). Both use the
SHBrowseForFolder API call to display the available shares and folders, but
because of the parameters set in the BROWSEINFO structure, provides the ability
to retrieve this information from the dialog.

See the Overview discussion above for more information on the options available
with the Browse for Files dialog.

--------------------------------------------------------------------------------
BAS Module Code
None.

--------------------------------------------------------------------------------
Form Code
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-2004 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 = &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" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long

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

Private 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 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

Cheers

 

Thanks Jurg and Luis.


Ciao.

 

.. . . but what we were looking for, is a "pure" Vlisp code . . .

 

. . . but what we were looking for, is a "pure" Vlisp code . . .
It is is a "pure" Vlisp code . . .


--

Marc'Antonio Alessi
http://xoomer.virgilio.it/alessi
(strcat "NOT a " (substr (ver) 8 4) " guru.")

--

 

Given that the ActiveX component used is a native part
of the operating system, what is the point/purpose to 'pure'
VLISP code?

 

The 'RootFolder' is the folder whose children are
at the top level of the tree. IOW, you can only
select children of the root folder, not the root
folder itself. You would have to set the root
folder to C:\

 

I think that the question is :
what have we to do, to get a "browse for folder" dialog,
WITHOUT external DLLs or ARXs ?
Because already there are
DOSLIB that has its own BrowseForFolder function,
ObjectDCL that provides the same thing,
and may be that the acet-xxx functions collection provides still the
same thing,

I don't have no need of some other DLLs to sobstitute other DLLs (the ARX).

When I say "pure" Vlisp code,
I want mean "without adding and using other resources, extrernal to the
native OS environment and to the "pure" ACAD environment.

This mean : no extra DLL, no control to register . . .

Ciao
Domenico

 

Sorry but you're missing one key point, which is that the
ActiveX object that exposes the BrowseForFolder method
is the ActiveX automation interface to Windows Explorer.

 

not "pure" vlisp, but very easy

(acet-ui-pickdir "Select a folder:" "C:\\Temp\\")

express tools required

Bruno Toniutti