Option Explicit On 
'Option Strict On

Imports System
Imports System.Runtime.InteropServices
Imports System.Diagnostics
Imports System.Text

Public Class FolderBrowser
    Private Const BFFM_INITIALIZED As Integer = 1
    Private Const BFFM_SELCHANGED As Integer = 2
    Private Const BFFM_VALIDATEFAILED As Integer = 3
    Private Const BFFM_ENABLEOK As Integer = &H465
    Private Const BFFM_SETSELECTIONA As Integer = &H466
    Private Const BFFM_SETSTATUSTEXT As Integer = &H464

    Private Const BIF_RETURNONLYFSDIRS As Short = &H1S
    Private Const BIF_DONTGOBELOWDOMAIN As Short = &H2S
    Private Const BIF_STATUSTEXT As Short = &H4S
    Private Const BIF_RETURNFSANCESTORS As Short = &H8S
    Private Const BIF_EDITBOX As Short = &H10S
    Private Const BIF_VALIDATE As Short = &H20S
    Private Const BIF_USENEWUI As Short = &H40S
    Private Const BIF_BROWSEFORCOMPUTER As Short = &H1000S
    Private Const BIF_BROWSEFORPRINTER As Short = &H2000S
    Private Const BIF_BROWSEINCLUDEFILES As Short = &H4000S

    Private Const MAX_PATH As Short = 260



    Private Structure BrowseInfo
        Dim hOwner As Long
        Dim pidlRoot As Long
        Dim pszDisplayName As String
        Dim lpszINSTRUCTIONS As String
        Dim ulFlags As Long
        Dim lpfn As Long
        Dim lParam As Long
        Dim iImage As Long
    End Structure

    Private Structure SHFILEOPSTRUCT
        Dim hwnd As Long
        Dim wFunc As Long
        Dim pFrom As String
        Dim pTo As String
        Dim fFlags As Integer
        Dim fAnyOperationsAborted As Boolean
        Dim hNameMappings As Long
        Dim lpszProgressTitle As String
    End Structure
    <DllImport("shell32.dll", CharSet:=CharSet.Ansi)> _
        Private Shared Function SHBrowseForFolder(ByRef lpBrowseInfo As BrowseInfo) As Long
    End Function

    <DllImport("shell32.dll", CharSet:=CharSet.Ansi)> _
    Private Shared Function SHGetPathFromIDList(ByVal pidl As Long, ByVal pszPath As String) As Integer
    End Function



    Function BrowseFolder(Optional ByVal Caption As String = "") As String

        Dim BrowseInfo As BrowseInfo
        Dim FolderName As String
        Dim ID As Long
        Dim Res As Long

        With BrowseInfo
            .hOwner = 0
            .pidlRoot = 0
            .pszDisplayName = Str(MAX_PATH)
            .lpszINSTRUCTIONS = Caption
            .ulFlags = BIF_RETURNONLYFSDIRS
            .lpfn = 0
        End With

        FolderName = Str(MAX_PATH)

        ID = SHBrowseForFolder(BrowseInfo)

        If ID Then
            Res = SHGetPathFromIDList(ID, FolderName)
            If Res Then
                BrowseFolder = Left(FolderName, InStr(FolderName, _
                    vbNullChar) - 1)
            End If
        End If

    End Function





End Class