VBA - 取消getfolder时避免错误

Question

取消选择文件夹时出现基本错误。我只想在按下取消按钮时退出Sub。

我正在使用以下代码

Set recsFolder = fso.GetFolder(Functions.GetFolder("C:\"))

Function GetFolder(strPath As String) As String
Dim Fldr As FileDialog
Dim sItem As String
Set Fldr = Application.FileDialog(msoFileDialogFolderPicker)
With Fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set Fldr = Nothing
End Function

Answer 1

来自最佳来源之一的建议：http://www.cpearson.com/excel/browsefolder.aspx

Function BrowseFolder(Title As String, _
                Optional InitialFolder As String = vbNullString, _
                Optional InitialView As Office.MsoFileDialogView = msoFileDialogViewList)_
                As String
    Dim V As Variant
    Dim InitFolder As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = Title
        .InitialView = InitialView
        If Len(InitialFolder) > 0 Then
            If Dir(InitialFolder, vbDirectory) <> vbNullString Then
                InitFolder = InitialFolder
                If Right(InitFolder, 1) <> "\" Then
                    InitFolder = InitFolder & "\"
                End If
                .InitialFileName = InitFolder
            End If
        End If
        .Show
        On Error Resume Next
        Err.Clear
        V = .SelectedItems(1)
        If Err.Number <> 0 Then
            V = vbNullString
        End If
    End With
    BrowseFolder = CStr(V)
End Function

Answer 2

错误发生在

中

Set recsFolder = fso.GetFolder(Functions.GetFolder("C:\"))

因为取消文件夹选择时函数GetFolder返回空字符串

快速解决方案，只需将您的逻辑更改为：

Dim strReturned As String
strReturned = Functions.GetFolder("C:\")

If strReturned <> "" Then
    Set recsFolder = fso.GetFolder(strReturned)
End If

如果文件夹为空，

绕过Set recsFolder

Answer 3

我已经阅读了你的所有答案，并感谢你们，但我无法应用它们。相反，我使用了错误处理（我知道我应该避免，但它不会损坏代码）。

        On Error GoTo ErrHandlr:
    Set recsFolder = fso.GetFolder(Functions.GetFolder("C:\"))
ErrHandlr:
Exit Sub