ユーザーがダイアログボックスをキャンセルしたときにマクロを使用せずに保存するフォルダを選択する

Question

現在のファイルをマクロのフリーファイルとして保存するように求めるメッセージが表示される場合、キャンセルするとエラーが発生する。私は、ユーザーがキャンセルをヒットしたときに最初からやり直すコードが必要です。メッセージボックスがポップアップし、ファイルを保存する場所を選択してからダイアログボックスが再度ポップアップし、ファイルを保存する場所をユーザーが選択できるようにし、ユーザーがもう一度キャンセルしてから終了するように指示するのが最善の方法です。

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 

Answer 1

（未テスト）このような何かを、あなたがエラーを回避したい場合（キャンセルするとChooseFolder()が空になるので）空の文字列にSet objFolder = objFSO.GetFolder(ChooseFolder)を実行し、同時に彼に2回質問します - なぜ2度質問したいのですか？ - あなたはこのようにマクロを書くべきです：

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 

Answer 2

私はそれが本当にユーザーを困らせることができますようにこれを行うことをお勧めいけない、しかし、基本的にはあなただけ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)