VBA宏中Application.FileDialog(msoFileDialogFolderPicker)路径逻辑异常求助

核心错误点 #

• 取消按钮逻辑失效：点击【取消】时仅跳转标签但未终止宏，后续仍执行创建、保存操作；点击【确定】时获取的文件夹路径未被使用，反而引用未赋值的变量导致路径错误。
• 路径拼接缺失：保存时未将选中文件夹与文件名拼接，直接用文件名会保存到Excel默认路径（如“文档”文件夹）。
• 冗余无效代码：NextCode标签后的sItem = GetFolder无意义，GetFolder变量从未赋值。

修复后的完整代码 #

Sub CopySheetAsNewWorkbookWithPickingFileLocation()
    Dim theNewWorkbook As Workbook
    Dim currentWorkbook As Workbook
    Dim newFileName As String
    Dim fldr As FileDialog
    Dim saveFolder As String

    ' 选择保存文件夹
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        ' 点击取消直接退出宏
        If .Show <> -1 Then Exit Sub
        saveFolder = .SelectedItems(1)
    End With
    Set fldr = Nothing

    ' 以当前工作表名作为新文件名
    newFileName = ActiveSheet.Name

    ' 创建新工作簿并复制目标工作表
    Set currentWorkbook = ActiveWorkbook
    Set theNewWorkbook = Workbooks.Add
    currentWorkbook.ActiveSheet.Copy Before:=theNewWorkbook.Sheets(1)

    ' 删除新工作簿中默认的多余工作表
    Application.DisplayAlerts = False
    Dim i As Integer
    For i = theNewWorkbook.Sheets.Count To 2 Step -1
        theNewWorkbook.Sheets(i).Delete
    Next i
    Application.DisplayAlerts = True

    ' 拼接完整路径并保存文件
    theNewWorkbook.SaveAs Filename:=saveFolder & "\" & newFileName & ".xlsx", FileFormat:=61
    theNewWorkbook.Close
End Sub

关键修改说明 #

1. 取消操作直接终止：将GoTo NextCode改为Exit Sub，点击【取消】时直接退出宏，不再执行后续步骤。
2. 正确使用选中路径：将获取的文件夹路径存入saveFolder变量，保存时拼接为完整路径，确保文件存入选中文件夹。
3. 清理冗余代码：删除无效的NextCode标签及相关语句，简化逻辑结构。

内容的提问来源于stack exchange，提问作者Teddy Hanna