GetSaveAsFilename - change file type, runtime error 1004

Hello,

I have a workbook that I'm trying to suggest a filename for when the user selects Save As. That's all I wanted to achieve but it's getting increasing complicated and now I have a runtime error I can't seem to find a way around.

I want to allow the user the ability to select a .xlsx file type if they wish, which all works fine until it hits ThisWorkbook.SaveAs when I get a runtime 1004 error:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim sFullName As String, sFileName As String, sPathName As String, sCurDir As String
Dim lOverwrite As Long
Dim sExt As String
Dim wsWork As Worksheet: Set wsWork = ThisWorkbook.Worksheets("Workings")

Application.EnableEvents = True
Application.ScreenUpdating = False

    'Store current directory in variable, restore it later
    sCurDir = CurDir

    'If the user clicks SAVE AS...
    If SaveAsUI = True Then

        'Switch to desired directory
        If Len(sPathName) > 0 Then
            ChDrive sPathName
            ChDir sPathName
        End If

        ' loop until unique name is entered
        Do

          'suggested filename for save as dialog box
          sFileName = Format(CVDate(Now), wsWork.Range("nrNameDateFormat").Value) & wsWork.Range("nrName").Value
          sFullName = Application.GetSaveAsFilename(sFileName, FileFilter:="Excel Macro-Enabled Workbook (*.xlsm),*.xlsm,Excel Workbook (*.xlsx),*.xlsx", _
          Title:="Save As")
            
          'exit if cancelled
          If Len(sFullName) = 0 Then GoTo Abort
          If sFullName = "False" Then GoTo Abort

          'if name is unique, exit loop and save file
          If Not FileExists(sFullName) Then Exit Do

          'Message user to confirm overwrite
          lOverwrite = MsgBox("A file named '" & GetFileName(sFullName) & "' already exists in the location chosen." & _
          vbNewLine & vbNewLine & "Do you want to overwrite the existing file?", vbYesNoCancel + vbQuestion, "File Exists")

          Select Case lOverwrite
            Case vbYes
              'overwrite existing file
              Exit Do
            Case vbNo
              'do nothing, loop again to get new filename
            Case vbCancel
              'bail out
              GoTo Abort
          End Select
        Loop
        
        'finally, save the file using filename from above
        sExt = GetFileExt(sFullName)
        Application.EnableEvents = False
        Application.DisplayAlerts = False
        Debug.Print sFullName; sExt
        ThisWorkbook.SaveAs FileName:=sFullName, FileFormat:=sExt
        Application.DisplayAlerts = True
        Application.EnableEvents = True

        'do not resave the workbook
        Cancel = True

    End If

Exit Sub

Abort:

    'restore previous current directory (skip if error encountered)
    On Error Resume Next
    ChDrive sCurDir
    ChDir sCurDir
    On Error GoTo 0

    'do not resave the workbook
    Cancel = True

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Originally I didn't have the FileFormat specified and it gave me a runtime 1004 error with text stating that it couldn't be saved as this file type.

sFullName contains: \\...\Profile\Desktop\SaveAs TestMacro\2017-10-10RMSelfTestResultsSR.xlsx ("..." are to shorten the string for visibility in this posting, the full file path is actually correct)
sExt contains: .xlsx

The code works fine if saving as an .xlsm file.

Anyone have any ideas what's wrong with this - or an alternative method of pre-populating the Save As filename?

Any assistance appreciated

Thanks, TC

Ah, I see. That simple!

I've modified the code again, but it just feels really clunky - it works fine. I've adapted someone else code to start with so perhaps that's why it doesn't quite feel right. The structure feels more unwieldy that it need be:

 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim sFullName As String, sFileName As String, sPathName As String, sCurDir As String, sExt As String
Dim lOverwrite As Long
Dim wsWork As Worksheet: Set wsWork = ThisWorkbook.Worksheets("Workings")
Dim iExt As Integer
Dim WarnMsg

    Application.EnableEvents = True
    Application.ScreenUpdating = False
    
    'Store current directory in variable, restore it later
    sCurDir = CurDir
    
    'If the user clicks SAVE AS...
    If SaveAsUI = True Then
        
        'Switch to desired directory
        If Len(sPathName) > 0 Then
            ChDrive sPathName
            ChDir sPathName
        End If
        
        ' loop until unique name is entered
        Do
        
            'suggested filename for save as dialog box
            sFileName = Format(CVDate(Now), wsWork.Range("nrNameDateFormat").Value) & wsWork.Range("nrName").Value
            sFullName = Application.GetSaveAsFilename(sFileName, FileFilter:="Excel Macro-Enabled Workbook (*.xlsm),*.xlsm,Excel Workbook (*.xlsx),*.xlsx", _
            Title:="Save As")

            'exit if cancelled
            If Len(sFullName) = 0 Then GoTo Abort
            If sFullName = "False" Then GoTo Abort
            
            'Check file type selected
            sExt = GetFileExt(sFullName)
            If sExt = ".xlsx" Then
                iExt = 51 'no macros
            Else
                iExt = 52 'macro enabled
            End If
            
            'if name is unique, exit loop and save file
            If Not FileExists(sFullName) Then
                'If file type has been changed to .xlsx warn user that macros will be removed
                If sExt = ".xlsx" Then
                    WarnMsg = MsgBox("The following features cannot be saved in macro-free workbooks:" & vbNewLine & vbNewLine & _
                    "- VB Project" & vbNewLine & vbNewLine & "To save a file with these features click No then choose a " & _
                    "macro-enabled file type in the file list." & vbNewLine & "To continue saving as a macro free workbook " & _
                    "click Yes.", vbInformation + vbYesNoCancel, "Microsoft Excel")
                    Select Case WarnMsg
                        Case vbYes
                            'overwrite existing file
                            Exit Do
                        Case vbNo
                            'do nothing - resume progress through loop
                        Case vbCancel
                            GoTo Abort
                    End Select
                Else 'extension remains .xlsm
                    'overwrite existing file
                    Exit Do
                End If
            Else 'filename NOT unique
                'Message user to confirm overwrite
                lOverwrite = MsgBox("A file named '" & GetFileName(sFullName) & "' already exists in the location chosen." & _
                vbNewLine & vbNewLine & "Do you want to overwrite the existing file?", vbYesNoCancel + vbQuestion, "File Exists")
                
                Select Case lOverwrite
                    Case vbYes
                        'If file type has been changed to .xlsx warn user that macros will be removed
                        If sExt = ".xlsx" Then
                            WarnMsg = MsgBox("The following features cannot be saved in macro-free workbooks:" & vbNewLine & vbNewLine & _
                            "- VB Project" & vbNewLine & vbNewLine & "To save a file with these features click No then choose a " & _
                            "macro-enabled file type in the file list." & vbNewLine & "To continue saving as a macro free workbook " & _
                            "click Yes.", vbInformation + vbYesNoCancel, "Microsoft Excel")
                            Select Case WarnMsg
                                Case vbYes
                                    'overwrite existing file
                                    Exit Do
                                Case vbNo
                                    'do nothing - resume progress through loop
                                Case vbCancel
                                    GoTo Abort
                            End Select
                        Else 'extension remains .xlsm
                            'overwrite existing file
                            Exit Do
                        End If
                    Case vbNo
                        'do nothing, loop again to get new filename
                    Case vbCancel
                        'bail out
                        GoTo Abort
                End Select
            End If
        Loop
        
        'Save the file using filename provided
        Application.EnableEvents = False
        Application.DisplayAlerts = False
        ThisWorkbook.SaveAs FileName:=sFullName, FileFormat:=iExt
        Application.DisplayAlerts = True
        Application.EnableEvents = True
        
        'do not resave the workbook
        Cancel = True
        
    End If
    
Exit Sub '-------------------------------------------------------
    
Abort:
    
    'restore previous current directory (skip if error encountered)
    On Error Resume Next
    ChDrive sCurDir
    ChDir sCurDir
    On Error GoTo 0
    
    'do not resave the workbook
    Cancel = True
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Am I missing something, or worrying about nothing?

Marking post as solved because my initial problem has been - but would still appreciate any input regarding streamlining structure.