Option Strict Off
Option Explicit On
Module modFolderBrowse
	'This module contains all the declarations to use the
	'Windows 95 Shell API to use the browse for folders
	'dialog box.  To use the browse for folders dialog box,
	'please call the BrowseForFolders function using the
	'syntax: stringFolderPath=BrowseForFolders(Hwnd,TitleOfDialog)
	'
	'For contacting information, see other module

    Public Structure BrowseInfo
        Dim hwndOwner As Integer
        Dim pIDLRoot As Integer
        Dim pszDisplayName As Integer
        Dim lpszTitle As String
        Dim ulFlags As Integer
        Dim lpfnCallback As Integer
        Dim lParam As Integer
        Dim iImage As Integer
    End Structure

    Public Const BIF_RETURNONLYFSDIRS As Short = 1
    Public Const MAX_PATH As Short = 260

    Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Integer)
    Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Integer
    'UPGRADE_WARNING: Structure BrowseInfo may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC/commoner/redir/redirect.htm?keyword="vbup1050"'
    Public Declare Function SHBrowseForFolder Lib "shell32" (ByRef lpbi As BrowseInfo) As Integer
    Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Integer, ByVal lpBuffer As String) As Integer

    Public Function BrowseForFolder(ByRef hwndOwner As Integer, ByRef sPrompt As String) As String
        Dim iNull As Short
        Dim lpIDList As Integer
        Dim lResult As Integer
        Dim sPath As String
        Dim udtBI As BrowseInfo

        'initialise variables
        With udtBI
            .hwndOwner = hwndOwner
            .lpszTitle = sPrompt
            .ulFlags = BIF_RETURNONLYFSDIRS
        End With
        'Call the browse for folder API
        lpIDList = SHBrowseForFolder(udtBI)
        'get the resulting string path
        If lpIDList Then
            sPath = New String(Chr(0), MAX_PATH)
            lResult = SHGetPathFromIDList(lpIDList, sPath)
            Call CoTaskMemFree(lpIDList)
            iNull = InStr(sPath, vbNullChar)
            If iNull Then sPath = Left(sPath, iNull - 1)
        End If
        'If cancel was pressed, sPath = ""
        BrowseForFolder = sPath
    End Function
End Module