Option expedition
Private Type Browseinfo LNGHWND AS Long Pidlroot As Long PszdisplayName As Long Lpsztitle As Long Ulflags As Long Lpfncallback As Long LParam As Long IImage As LONGEND TYPE
Private const bif_returnonlyfsdirs = 1private const Max_path = 260
Private Declare Sub Cotaskmemfree Lib "Ole32.dll" _ (Byval HMEM As Long)
Private Declare Function lstrcat Lib "Kernel32" _ Alias "lstrcatA" (ByVal lpString1 As String, _ ByVal lpString2 As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32" _ (lpbi As BrowseInfo) As Long Private Declare Function SHGetPathFromIDList Lib "shell32 "_ (Byval Pidlist As Long, Byval Lpbuffer AS String) AS LONG
Public Function Browseforfolder (Byval Strompt As String) AS STRING
On Error Goto EhbrowseForfolder 'Trap for ERRORS
DIM INTNULL AS INTEGER DIM LNGIDLIST ASUG, LNGRESULT AS Long Dim Strpath As String Dim Udtbi as Browseinfo
'Set API Properties (Housed In A UDT) with udtbi .lnghwnd = lnghwnd .lpsztitle = LSTRCAT (STRPROMPT, "") .ulflags = Bif_Returnlyfsdirs End with
'Display the Browse Folder ... LNGIDLIST = ShbrowseForfolder (UDTBI)
If LNGIDLIST <> 0 THEN 'CREATE STRING OF NULLS SO IT WILL FILL IN with THE PATH STRPATH = String (Max_Path, 0)
'Retrieves the path selected, places in the null' character filled string lngresult = shgetpathfromidlist (LNGIDLIST, STRPATH)
'FREES MEMORY CALL COTASKMEMFREE (LNGIDLIST)
'Find the first instance of a null character,' so we can get just the path intNull = InStr (strPath, vbNullChar) 'Greater than 0 means the path exists ... If intNull> 0 Then' Set the value strPath = Left ( StrPath, Intnull - 1) end if end'return the path name bromentForfolder = STRPATH EXIT FUNCTION '
EHBROWSEFORFOLDER:
'Return no value browseforfolder = EMPTY
END FUNCTION
