Saving xlsm as xlsx with VBA no longer works due to new save prompt

Question

we have a xlsm file that processes some data and finally saves the file as xlsx in a different folder.

earlier the save prompt when saving as non-macro workbook would have 3 options: "yes", "no" and "help" with yes as default meaning we save and discard code, but now the prompt is having 4 options with "back" as the default and hence the vba code fails

?so how do we get the old prompt version back?

?Or alternatively, can the default choice in the new prompt be "save and discard functions"?

(sorry I only have the danish version of that prompt so my translation may not be exact)

?Do any of you know where this new prompt comes from - is it in the Application.Dialogs collection and if so what is it called?

and please I'm not talking about the first prompt, but the second - after pressing save where it says that

"the following features cannot be saved in macro-free workbooks" (see images below)

this is the one that changed from 3 to 4 buttons with "back" as default option

The code has been working for years, but now - for some users - Excel shows a different prompt when trying to save as macrofree workbook. therefore setting Application.DisplayAlerts = False is not working as it chooses the default option, which in case of the new prompt is to go back, and then an error occurs in the code

on computers with this prompt the VBA code works since "yes" is the default choice:

on computers with this prompt the VBA code fails since "Gå tilbage" (= "Go back") is the default choice:

example code for the save part that fails:

Sub saveas()


Dim fil As String, path As String
Dim wb As Workbook
Dim Nyfil As String

Set wb = ThisWorkbook

fil = wb.Name
path = wb.path

Nyfil = Replace(fil, ".xlsm", ".xlsx", , , vbTextCompare)

wb.Save

Application.DisplayAlerts = False
wb.saveas Filename:=path & "\" & Nyfil, FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True

End Sub

Answer 1

The following will work only if you don't have code in the worksheets modules, but maybe it helps you or someone else. The code will copy all sheets into a new workbook and save that new workbook. However, copying worksheets will copy also the code within the sheets, so if a sheet holds code, you will face the same problem again.

If your workbook contains hidden sheets and you want to copy them also, you temporarily have to make them visible, else they will not be copied.

Sub copyAsMacrofreeWB()

    Dim i As Long
    ReDim sheetsVisible(1 To ThisWorkbook.Sheets.Count) As XlSheetVisibility
    
    ' Unhide all sheets
    For i = 1 To ThisWorkbook.Worksheets.Count
        sheetsVisible(i) = ThisWorkbook.Worksheets(i).Visible
        Dim ws As Worksheet
        ThisWorkbook.Worksheets(i).Visible = xlSheetVisible
    Next

    Dim newName As String
    newName = Replace(ThisWorkbook.FullName, ".xlsm", "macrofree.xlsx")
    
    ThisWorkbook.Sheets.Copy
    Dim newWB As Workbook
    Set newWB = ActiveWorkbook
    newWB.SaveAs newName, FileFormat:=xlOpenXMLWorkbook
    
    ' Hide sheets
    For i = 1 To ThisWorkbook.Worksheets.Count
        ThisWorkbook.Worksheets(i).Visible = sheetsVisible(i)
        newWB.Worksheets(i).Visible = sheetsVisible(i)
    Next
    
End Sub

Answer 2

Please, try this (complicated) way, but able to save the workbook as you need. It needs a timer created in a Word document, to be started from Excel before SaveAs, which will find the message window handler, the apropriate button hwnd and clicking it using API:

1. Create a docm document (in Word, of course) and name it as you want, but update the next code with its real name. You can use the name I used and no need to update/change anything. I named it Test Word VBA.docm.

2. Insert a standard module and name it Mod_Timer. Please, copy the next code in the respective code module:

Option Explicit


Private Declare PtrSafe Function SetTimer Lib "user32" ( _
        ByVal hwnd As LongPtr, ByVal nIDEvent As Long, _
        ByVal uElapse As Long, ByVal lpTimerFunc As LongLong) As Long

Private Declare PtrSafe Function KillTimer Lib "user32" ( _
                    ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
                    
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
             (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwnd1 As LongPtr, _
            ByVal hwnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, _
                                        ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As Long
                                        
                    
Private TimerID As Long, TimerSeconds As Long
Private messHwnd As LongPtr, WorkNo As Long

Public Sub StartTimer()
    messHwnd = CLngPtr(0)
    TimerSeconds = 10 ' how often the timer checks...
    If TimerID <> 0 Then Exit Sub 'to avoid two runing timer sessions...
    TimerID = SetTimer(0&, 0&, TimerSeconds * 100, AddressOf T_Pr)
    WorkNo = WorkNo + 1
    If WorkNo >= 10 Then Debug.Print "Number exceeded the normal range...": StopTimer
End Sub

Sub StopTimer()
       On Error Resume Next
       KillTimer 0, TimerID: TimerID = 0
End Sub

Sub T_Pr(ByVal hwnd As Long, ByVal uMsg As Long, _
            ByVal nIDEvent As Long, ByVal dwTimer As Long)
      messHwnd = FindWindow("#32770", "Microsoft Excel"): Debug.Print Hex(messHwnd)
      If messHwnd <> CLngPtr(0) Then
           StopTimer
           PressCorrectButton
      End If
End Sub

Sub PressCorrectButton()
  Dim butSaveR As LongPtr
  Const WM_LBUTTON_DOWN = &H201, BM_CLICK = &HF5
  
   butSaveR = FindWindowEx(messHwnd, 0, "Button", "Save and &erase features")
   
   'click the necesary buton:
   SendMessage butSaveR, WM_LBUTTON_DOWN, 0&, 0&
   SendMessage butSaveR, BM_CLICK, 0, ByVal 0&
End Sub

3. Change your code with this (adapted) one. It calls startTimer sub from the Word document:

Sub saveasWorking()
 Dim fil As String, path As String, wb As Workbook, Nyfil As String
 Set wb = ActiveWorkbook ' ThisWorkbook

 fil = wb.name
 path = wb.path

 Nyfil = VBA.Replace(fil, ".xlsm", ".xlsx", , , vbTextCompare)

 wb.Save

  Dim myWord As Word.Application, doc As Word.Document
  Const wordDoc As String = "Test Word VBA.docm"
  Set myWord = GetObject(, "Word.Application")
  Set doc = myWord.Documents("wordDoc")
  If Not doc Is Nothing Then
    myWord.Run """'" & doc.name & """'!Mod_Timer.StartTimer" 'start the timer...
  Else
    MsgBox "Document """ & wordDoc & """ is not open in Word...: exit sub"
  End If
  Set myWord = Nothing
  
  'Without DisplayAlerts = False!!!
  wb.saveas FileName:=path & "\" & Nyfil, FileFormat:=xlWorkbookDefault

End Sub

Now, try running it.

It is good to know that the used API functions work only in 64 bit installations! It can be easily adapted to work in both. It is important to know that, because API calls may crush the application (if they are wrong defined)

This solution can be (also easily) improved to firstly check if a Word session already exists, if the necessary document is open and do what is necessary (opening session/document) if something is missing.

Please, send some feedback after testing it.

If something not clear enough, do not hesitate to ask for clarifications...