Code:
Public Function BrowseForFolder(ByVal lngHwnd As Long, ByVal strPrompt As String) As String On Error GoTo ehBrowseForFolder 'Trap for errors Dim intNull As Integer Dim lngIDList As Long, 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_RETURNONLYFSDIRS 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 If 'Return the path name BrowseForFolder = strPath Exit Function 'Abort ehBrowseForFolder: 'Return no value BrowseForFolder = Empty End Function