Custom *and* Original SaveAs Dialog Box Popping Up

[sioneld]

Hi guys

This is probably going to have a really simple solution that I've entirely failed to notice. However, I have a custom saveas dialog box Module which forces the file to save as .xlsm and gets the file name from certain cells.

I've called that module from an If function which checks the filename first.

Basically, this is me trying to stop the custom save as box from popping up unless it's the original (template) document. I was having problems with subsequent revisions and saves to the resulting file were also popping up the save-as box.

I seem to have fixed that, and it does seem to only be working if the file name matches. However, it then *also* pops up the original save as box, thereby making a user have to save the file twice.

If anyone can help me figure out why the original is still coming up I'd love to know!

The Module is called CPOSave and the code was written by OllieB on this site so I'm familiar with it but don't necessarily fully understand it. Code is:

Sub MySaveAs()
On Error Resume Next
Dim pvt_str_SaveAsName As String

'# cancel the original dialog
   Cancel = True
   
'# get the desired name and path, if none specified, exit the routine
With Application.FileDialog(msoFileDialogSaveAs)
      
      .Title = "Custom Save As"
      .ButtonName = "Save"
      .InitialView = msoFileDialogViewDetails
      .InitialFileName = ThisWorkbook.Worksheets("Sheet1").Cells(6, 6).Value & " " & Format(Now, "MMMM YYYY")
         
      If Not .Show Then
         Exit Sub
      Else
         pvt_str_SaveAsName = .SelectedItems(1)
      End If
         
   End With
   
'# replace the extension specified by the user with the fixed extension as required - and save the workbook
   pvt_str_SaveAsName = Left$(pvt_str_SaveAsName, InStrRev(pvt_str_SaveAsName, ".") - 1) & ".xlsm"
   Application.EnableEvents = False
   ThisWorkbook.SaveAs pvt_str_SaveAsName, xlOpenXMLWorkbookMacroEnabled
   Application.EnableEvents = True

End Sub

And the code that calls it is:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If LCase(Left$(ActiveWorkbook.Name, 13)) = LCase("Template Name") Then
    Call CPOSave.MySaveAs
Else
    Exit Sub
End If
End Sub

[romperstomper]

Your Cancel = True line needs to be in the BeforeSave routine.

[sioneld]

Legend! Thank you

[romperstomper]

Glad to help.