: How Can I Make A "Browse For Folder" Dialog Like I See All The Time, With "Make New Folder" etc.
:
Look for help on the "SHBrowseForFolder" function in the MSDN.
I have code to let user to select a folder without "Make New Folder" but this function can do more.
Mike
Option Explicit
Private Type rBROWSEINFOType
lOwner As Long
lRoot As Long
sDiplayName As String
sTitle As String
lFlags As Long
lPfn As Long
lParam As Long
lImage As Long
End Type
Private Declare Function Mod_lSHBrowseForFolder Lib "Shell32.dll" _
Alias "SHBrowseForFolder" _
(rBrowseInfo As rBROWSEINFOType) As Long
Private Declare Function Mod_lSHGetPathFromIDList Lib "Shell32.dll" _
Alias "SHGetPathFromIDListA" _
(ByVal lPathID As Long, ByVal sPath As String) As Long
Private Function Mod_sPathDialog() As String
'''**********************************************************************
'''Description: displays dialog form to select a directory
'''
'''Returns: result of the dialog
'''**********************************************************************
On Error GoTo ErrorHandler
Dim rBrowseInfo As rBROWSEINFOType
Dim lPathID As Long
Dim sPath As String
'''initialise parameters
With rBrowseInfo
.lOwner = 0&
.lRoot = 0&
.sTitle = "Select folder"
.lFlags = 0
End With
'''Get path ID (this will display dialog form)
lPathID = Mod_lSHBrowseForFolder(rBrowseInfo)
'''Initialise the buffer
sPath = Space$(512)
'''Get the string
If Mod_lSHGetPathFromIDList(lPathID, sPath) Then
'''Remove nullchars
sPath = Mod_sTrimNull(sPath)
Mod_sPathDialog = sPath
End If
Exit Function
ErrorHandler:
Call MsgBox(Err.Description)
End Function
Private Function Mod_sTrimNull _
( _
ByVal sString As String _
) As String
'''***********************************************************************
'''Arguments:
''' sString - String from which null characters are striped.
'''
'''Description: This procedure searches for a null character in the
''' passed string. If one is found the string is truncated
''' to remove the null and all characters that follow it.
''' If the first character is a null then the result is an
''' empty string.
'''
'''Returns: String striped of nulls
'''***********************************************************************
Dim lNullPos As Long '''Position of null character in string
'''If the string is not empty to begin with
If Len(sString) Then
'''Search for a null character in the string
lNullPos = InStr(sString, vbNullChar)
'''Determine if a null character was found
Select Case lNullPos
Case 0
'''Do Nothing, there are no nulls in the string.
Case 1
'''The first character was a null
sString = ""
Case Else
'''Truncate string to remove null character
sString = Left$(sString, lNullPos - 1)
End Select
End If
Mod_sTrimNull = sString '''Return the resulting string
End Function
