Browse for folder (shell32)

[bandit_1981]

I am using this same chunk of code i think most of this board uses but i need a slight change to it. I do not want the user to be able to select anything until they close the dialog. As it is now they can choose the user form that has the button that displays it. IE Excel -> UserForm -> Dialog Box. User are very click happy and will certainly open many dialogs before they stop clicking.

 

[Norie]

What code are you using?

What do you actually want to do?

 

[bandit_1981]

Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
    bInfo.hOwner = 0
'   Root folder = Desktop
    bInfo.pidlRoot = 0&
'   Title in the dialog
    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

What i want it todo is keep focus on the dialog box until the dialog box is closed out. As it works now you can click on level back and keep launching the dialog.

 

[Norie]

Could you actually post all the code?

As far as I know if you open a dialog it will have focus until it's closed.

 

[bandit_1981]

'32-bit API declaration
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Const BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260
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
Declare Function GetSystemMetrics Lib "user32" _
  (ByVal nIndex As Long) As Long

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

Private Sub cmdBackupLoc_Click()
    On Error Resume Next
    'allow the user to select the folder to backup to
    Call GetAFolder(0, "Please select a location for the backup.")
End Sub

Sub GetAFolder(ByVal intOpt As Long, ByVal vmessage As String)
On Error Resume Next
Dim Msg As String
Dim UserFile As String
    Msg = vmessage
    UserFile = GetDirectory(Msg)
    If UserFile = "" Then
        MsgBox "No folder selected"
    Else
        If intOpt = 0 Then
            frmBackUp.lblpath.Caption = UserFile
        Else
            frmBackUp.lblrestoreloc.Caption = UserFile
        End If
    End If
End Sub

Function GetDirectory(Optional Msg) As String
On Error Resume Next
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
    bInfo.hOwner = 0
'   Root folder = Desktop
    bInfo.pidlRoot = 0&
'   Title in the dialog
    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

 

[Norie]

Sorry I was wrong.

You can get go back to the userform.

Here's some code I used to let the user browse for a folder when they click a command button on a userform.

Private Sub CommandButton1_Click()
    CommandButton1.Enabled = False
    MsgBox GetFolder
End Sub

Private Function GetFolder() As String
'common UDF for getting a folder name
    Dim ff As Object
    Set ff = CreateObject("Shell.Application"). _
             BrowseForFolder(0, "Please select a folder", 0, "c:\\")
    If Not ff Is Nothing Then
        GetFolder = ff.Items.Item.Path
    Else
        GetFolder = vbNullString
    End If
    CommandButton1.Enabled = True
End Function

Obviously it uses a different method to show the dialog but perhaps you could use the same idea ie enabling/disabling the command button.

 

[bandit_1981]

Sure does give me an idea thanks.