Wählen Sie Ordner ohne Makro, wenn Benutzer Abbrechen Dialogfeld

Question

mein Code fordert Benutzer zum Speichern der aktuellen Datei als eine Makro-freie Datei, das Problem ist, dass, wenn der Benutzer abbrechen dann bekomme ich einen Fehler. Ich brauche meinen Code neu zu starten, wenn der Benutzer abbricht. Es wäre also am besten, wenn ein Meldungsfeld erscheint und sagt, bitte wählen Sie den Speicherort, um die Datei zu speichern und das Dialogfeld erscheint wieder, damit der Benutzer auswählen kann, wo die Datei gespeichert werden soll.

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

Wenn Sie den Fehler vermeiden wollen Sie haben auf "Cancel" (kommt aus der Tatsache, dass Sie Set objFolder = objFSO.GetFolder(ChooseFolder) auf eine leere Zeichenfolge ausführen (seit ChooseFolder() zurückkehrt leer, wenn der Benutzer die Aktion abbricht) und gleichzeitig fragen ihn zweimal - warum wollten Sie sie zweimal fragen? - Dann solltest du dein Makro so schreiben:

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

Ich empfehle nicht, dies zu tun, wie es wirklich den Benutzer verärgern kann, aber im Grunde Sie es nur ein Do Loop setzen in - so etwas wie diese (nicht getestet)

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)