Attribute VB_Name = "Tree"
Option Explicit

'**************************************
'Windows API/Global Declarations for:
'Using win32 common browse box in Excel VBA
'**************************************

Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
    
    
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
   Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
    Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long


'********************************************************************************
' Name: Using win32 common browse box in Excel VBA
' Description:I have a few macros that use the Win32 common Browse box.
' See http://www.j-walk.com/ss/tip29.htm for details. hans@usit.net (Ed Hansberry)
'
' Inputs:None
'
' Returns:None
'
' Assumes:What I cannot figure out for the life of me is how to pass a starting
' folder to it. It always starts at Desktop. I can see that it is
' passed at the line I have an asterisk by, but don't know how to
' reference something like "C:\Documents\Analysis" .I only want it to
' start there the *first* time it runs. After that, I will store the
' path in the registry and then would like to pass it to the function on
' subsequent runs.
'
' Side Effects:None
' This code is copyrighted and has limited warranties.
' Please see http://www.Planet-Source-Code.com/xq/ASP/txtCodeId.501/lngWId.1/qx/vb/scripts/ShowCode.htm
' for details.
'********************************************************************************

Function GetDirectory(Optional Msg) As String
    Dim bInfo As BROWSEINFO
    Dim path As String
    Dim r As Long, x As Long, pos As Integer
    
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
    Else
        bInfo.lpszTitle = Msg
    End If
    'Type of directory to return
    bInfo.ulFlags = &H1
    'Display the dialog
    x = SHBrowseForFolder(bInfo)
    'Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)

    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function