用户取消对话框时,选择要在没有宏的情况下保存的文件夹

时间:2017-12-20 22:42:13

标签: excel vba excel-vba

我的代码提示用户将当前文件保存为宏免费文件,问题是如果用户点击取消则会出现错误。我需要我的代码在用户点击取消时重新开始。因此,最好是弹出一个消息框并说请选择保存文件的位置,然后再次弹出对话框,以便用户可以选择保存文件的位置,如果用户再次取消取消,则退出。

Sub SaveWithoutMacro()
Dim objFolder As Object, objFSO As Object

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ChooseFolder)

Application.ScreenUpdating = False
Application.DisplayAlerts = False


ActiveWorkbook.SaveAs Filename:=objFolder & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & ".xlsx", FileFormat:=51, password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

If objFolder <> False Then Exit SaveWithoutMacro = objFolder


Application.DisplayAlerts = True
Application.ScreenUpdating = True



End Sub

Function ChooseFolder() As String
Dim fldr As FileDialog
Dim sItem As String

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder to save down the copy of this workbook"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With

NextCode:
    ChooseFolder = sItem
    Set fldr = Nothing
End Function 

2 个答案:

答案 0 :(得分:0)

我不建议这样做,因为它可以让用户感到烦恼,但基本上你只是将它放入Do Loop - 这样的事情(未经测试)

With fldr
    .Title = "Select a Folder to save down the copy of this workbook"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    Do Until .Show <> -1
        If .SelectedItems(1) <> "" Then GoTo NextCode
    Loop
End With

NextCode:
    ChooseFolder = .SelectedItems(1)

答案 1 :(得分:0)

如果你想避免你所犯的错误&#34;取消&#34; (来自你在空字符串上执行Set objFolder = objFSO.GetFolder(ChooseFolder)的事实(因为ChooseFolder()如果用户取消操作则返回空)并同时问他两次 - 为什么你想要问他们两次? - 然后你应该写这样的宏:

Sub SaveWithoutMacro()
    folderPath = ChooseFolder() '<-- ask them to select once
    If folderPath = "" Then '<-- if they clicked cancel once
        MsgBox "You didn't select a folder", vbCritical, "Are you sure?" '<-- message box to inform them
        folderPath = ChooseFolder() '<-- ask them again to select
        If folderPath = "" Then Exit Sub '<-- if again empty, then exit procedure
    End If
    'rest of your save code