0

So, I am using the following code (modified a little by me), from http://www.cpearson.com/excel/browsefolder.aspx in order to get a path of a folder:

Function str_BrowseFolder(Optional ByVal DialogTitle As String) As String

    On Error GoTo str_BrowseFolder_Error

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' BrowseFolder
    ' This displays the standard Windows Browse Folder dialog. It returns
    ' the complete path name of the selected folder or vbNullString if the
    ' user cancelled.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    If DialogTitle = vbNullString Then
        DialogTitle = "Select A Folder"
    End If

    Dim uBrowseInfo     As BROWSEINFO
    Dim szBuffer        As String
    Dim lID             As Long
    Dim lRet            As Long

    With uBrowseInfo
        .hOwner = 0
        .pidlRoot = 0
        .pszDisplayName = String$(MAX_PATH, vbNullChar)
        .lpszINSTRUCTIONS = DialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS    ' + BIF_USENEWUI
        .lpfn = 0
    End With

    szBuffer = String$(MAX_PATH, vbNullChar)
    lID = SHBrowseForFolderA(uBrowseInfo)

    If lID Then
        ''' Retrieve the path string.
        lRet = SHGetPathFromIDListA(lID, szBuffer)
        If lRet Then
            str_BrowseFolder = Left$(szBuffer, InStr(szBuffer, vbNullChar) - 1)
        End If
    End If


    On Error GoTo 0
    Exit Function

str_BrowseFolder_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure str_BrowseFolder of Function mod_Browse"

End Function

Everything runs smoothly, unless I press "escape", when I have to select the folder already. Then, I get the ugly vba message "execution of the code was interrupted" and that's all. If I press "debug", I go to line "If lID Then" and I can actually continue with F8, without a problem. But the "on error" does not catch it at all.

So my questions are: Main question: 1. What can I do, in order to press "escape" without breaking the whole excel app? Not so main question: 2. Why the on error does not catch this?

Edit: I also have these public declarations:

Private Declare Function SHGetPathFromIDListA Lib "shell32.dll" (ByVal pidl As Long, ByVal pszBuffer As String) As Long
Private Declare Function SHBrowseForFolderA Lib "shell32.dll" (lpBrowseInfo As BROWSEINFO) As Long

Working with Office 2010, 32 bits, Windows 7.

Community
  • 1
  • 1
Vityata
  • 42,633
  • 8
  • 55
  • 100
  • 1
    I'm assuming SHBrowseForFolder is a routine, my guess is that when you press escape, it is returning a non-boolean answer (like -1), which is causing an error on that If L1D line. Although then, as you said, it should be caught by the on-error. Just spitballing a possible solution but I have no idea if its truly _the_ solution – RGA Jun 30 '16 at 13:27
  • @RGA See edit for ShBrowseForFolder – Vityata Jun 30 '16 at 13:31

2 Answers2

1

CpPearson is a great site indeed, but, why to complicate things that much?

Sub myPathForFolder()
    Dim FolderSelected As String
    FolderSelected = GetFolder(Environ("USERPROFILE") & "\Documents")
    If FolderSelected <> "" Then ' 1. If FolderSelected <> "" 'If not, it would mean user didn't select folder or pressed cancel
    'your stuff
    End If
End Sub
Function GetFolder(InitialLocation As String) As String
Dim FolderDialog As FileDialog
Dim SelectedFolder As String
    Set FolderDialog = Excel.Application.FileDialog(msoFileDialogFolderPicker)
        With FolderDialog
            .Title = "My Title For Dialog"
            .AllowMultiSelect = False
            .InitialFileName = InitialLocation
    If .Show <> -1 Then GoTo NextCode
    SelectedFolder = .SelectedItems(1)
    End With
NextCode:
    GetFolder = SelectedFolder
    Set FolderDialog = Nothing
End Function

EDIT:

Not really suggested, but, this may work:

Sub isGettingValue()
Application.EnableCancelKey = xlDisabled
myPath = str_BrowseFolder("DummyTitle")
Application.EnableCancelKey = xlInterrupt

For the second question, error is not getting it because it's not an error itself, stopping VBA is provoked by user.

Sgdva
  • 2,800
  • 3
  • 17
  • 28
  • Well, I liked the small window, that you get from the CPearson.Looks somehow professional and different. The big window, that I take from this code I am using to select a file. But thanks :) – Vityata Jun 30 '16 at 13:42
  • 1
    @Vityata Ok, I tried the code in cppearson, and I'm not getting the error while pressing ESC nor clicking cancel, I don't think it could be, but, is your office 64 bits? – Sgdva Jun 30 '16 at 13:49
  • my office is 32 bits. I also do not get an error, when I click "cancel" or the "x" box. – Vityata Jun 30 '16 at 13:56
  • Neither do I while pressing ESC in the keyboard, are you sure you are not pressing ctrl-esc? that breaks vba code – Sgdva Jun 30 '16 at 14:09
  • Definitely I do not press ctrl :) – Vityata Jun 30 '16 at 14:10
  • 1
    @Vityata Weird, but [this may be the case](http://www.excel-easy.com/vba/examples/interrupt-a-macro.html) or [this one](http://stackoverflow.com/questions/2154699/excel-vba-app-stops-spontaneously-with-message-code-execution-has-been-halted) check my updated response – Sgdva Jun 30 '16 at 14:19
  • it works :) But still I do not get why I it did not enter into the error catcher? Any ideas on this one? – Vityata Jun 30 '16 at 14:20
  • It's not an error itself, Excel is taking the "ESC" as intention to stop the VBA code, hence, the code interruption message (but, there's no error code since it's not an error) – Sgdva Jun 30 '16 at 14:23
  • That's true, but this escape is not taken into account into other cases (e.g. your initial proposal. – Vityata Jun 30 '16 at 14:25
  • OT: Excel behaves sometimes weirdly, this could be one of those cases "lost in space", for example, I wasn't able to replicate the problem because my esc key didn't break the code – Sgdva Jun 30 '16 at 14:26
0

So, at the end, my final code looks like this:

Private Declare Function SHGetPathFromIDListA Lib "shell32.dll" (ByVal pidl As Long, ByVal pszBuffer As String) As Long
Private Declare Function SHBrowseForFolderA Lib "shell32.dll" (lpBrowseInfo As BROWSEINFO) As Long
Private Const MAX_PATH = 260

Function str_BrowseFolder(Optional ByVal DialogTitle As String) As String

    On Error GoTo str_BrowseFolder_Error

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' BrowseFolder
    ' This displays the standard Windows Browse Folder dialog. It returns
    ' the complete path name of the selected folder or vbNullString if the
    ' user cancelled.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Application.EnableCancelKey = xlDisabled

    If DialogTitle = vbNullString Then
        DialogTitle = "Select A Folder"
    End If

    Dim uBrowseInfo     As BROWSEINFO
    Dim szBuffer        As String
    Dim lID             As Long
    Dim lRet            As Long

    With uBrowseInfo
        .hOwner = 0
        .pidlRoot = 0
        .pszDisplayName = String$(MAX_PATH, vbNullChar)
        .lpszINSTRUCTIONS = DialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS    ' + BIF_USENEWUI
        .lpfn = 0
    End With

    szBuffer = String$(MAX_PATH, vbNullChar)
    lID = SHBrowseForFolderA(uBrowseInfo)

    If lID Then
        ''' Retrieve the path string.
        lRet = SHGetPathFromIDListA(lID, szBuffer)
        If lRet Then
            str_BrowseFolder = Left$(szBuffer, InStr(szBuffer, vbNullChar) - 1)
        End If
    End If

    Application.EnableCancelKey = xlInterrupt

    On Error GoTo 0
    Exit Function

str_BrowseFolder_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure str_BrowseFolder of Function mod_Browse"

End Function
Vityata
  • 42,633
  • 8
  • 55
  • 100