Application.FileDialog Help with user Cancel

[Phil1981]

I am trying to control users save ability in excel and I am making use of the FileDialog function.

My issue is that no matter what I have tried ... if the user clicks cancel in the FileDialog box it errors.

I think by now I have just spent too much time looking at this code but if anyone could have a look and tell me where I am going wrong I would greatly appreciate it.

Sub SaveAs()
Dim ReportDate As Variant
Dim SaveFile, TeamLead, NewSaveFile As String
Dim NewSave As FileDialog
ReportDate = Format(Sheets(11).Range("$F$14"), "MMMM DD YYYY")
SaveFile = TeamLead & " -" & "Monthly Operational Action Plan" & " - " & ReportDate
TeamLead = Sheets(1).Range("D1")
Set NewSave = Application.FileDialog(msoFileDialogSaveAs)
 
On Error GoTo ErrMsg
    If MsgBox("File will be saved as" & vbCr & SaveFile & vbCr & "in the Fido Reporting drive, WAP folder.", vbOKCancel, "Saving") = vbCancel Then
        NewSave.Show
        If NewSave.Show = True Then
            NewSaveFile = NewSave.SelectedItems(1)
            ActiveWorkbook.SaveAs NewSaveFile
            MsgBox "You saved the file to:" & vbCr & NewSaveFile
            Exit Sub
        Else: GoTo ErrMsg
        End If
    End If
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="F:\MAPs\" & SaveFile
Application.DisplayAlerts = True
Exit Sub
ErrMsg:
    MsgBox "Your MAPs were not saved!", vbCritical
Exit Sub
End Sub

 

[John_w]

Try this version:

Sub SaveAs()
    Dim ReportDate As Variant
    Dim SaveFile, TeamLead, NewSaveFile As String
    Dim NewSave As FileDialog
    
    ReportDate = Format(Sheets(11).Range("$F$14"), "MMMM DD YYYY")
    SaveFile = TeamLead & " -" & "Monthly Operational Action Plan" & " - " & ReportDate
    TeamLead = Sheets(1).Range("D1")
    
    Set NewSave = Application.FileDialog(msoFileDialogSaveAs)
     
    If MsgBox("File will be saved as" & vbCr & SaveFile & vbCr & "in the Fido Reporting drive, WAP folder.", vbOKCancel, "Saving") = vbCancel Then

        With NewSave
            If .Show Then
                NewSaveFile = .SelectedItems(1)
                ActiveWorkbook.SaveAs NewSaveFile
                MsgBox "You saved the file to:" & vbCr & NewSaveFile
            Else
                MsgBox "Your MAPs were not saved!", vbCritical
            End If
        End With
        
    Else
    
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:="F:\temp\excel\" & SaveFile
        Application.DisplayAlerts = True
    
    End If
    
End Sub

 

[Scott Huish]

Why not use GetSaveAsFilename?

 

[Phil1981]

Thanks John,

Worked like a charm ... I knew I was over complicating things =)