vba - workaround for issue excel saving temp files - vba

Question

When saving a specific workbook, Excel creates a temp file instead of saving the data (without displaying an error or warning message). The symptoms are roughly the same as described in this post:
microsoft-excel-returns-the-error-document-not-saved-after-generating-a-2gb-temp-file
I tried several solutions, but decided to implement a work-around as ‘save as’ is working ok.
The code below performs the ‘save-as’, based on having filenames ending with a value (e.g. myFile V1.xlsm), the macro will add an incremental character (a to z) each time the workbook is saved. (e.g. myFile V1a.xlsm).
The macro works fine in a standard module, but it causes Excel to “stop responding” when moved to ‘thisWorkbook’. I ‘solved’ this by keeping it in the standard module and assigning key combination ‘control-s’ to the macro. Still interested to know if it can be made to work in the ‘thisWorkbook’.
Drawback of this workaround is that each incremental save clogs up the ‘recent file’ list. It would be nice to remove the previous file name from the recent file history, but this seems not possible to do via VBA. (VBA - How do I remove a file from the recent documents list in excel 2007?). Any suggestions?
Windows 10, Excel 2016 (version 16.0.6868.2060)
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim newFilename As String
Dim oldFilename As String
oldFilename = ActiveWorkbook.Name
newFilename = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)
If IsNumeric(Right(newFilename, 1)) = True Then
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path + "\" + newFilename & "a.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Else
If Right(newFilename, 1) = "z" Then
MsgBox "'z' reached, please save as new version"
Exit Sub
End If
newFilename = Left(newFilename, Len(newFilename) - 1) & Chr(Asc(Right(newFilename, 1)) + 1)
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path + "\" + newFilename & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End If
'potential code to remove oldFilename from 'Recent File' list
End Sub

Answer 1

I tested this Sub in Excel 2010 and it works for me. I immediately break the loop after deleting the file as I assume the indexing may get out of alignment with the loop. A more refined variant might loop through the recent file list and create a collection of indices to delete, then iterate backward over that collection and delete each entry in turn.
Public Sub RemoveRecentFile(strFileName As String)
Dim collRecentFiles As Excel.RecentFiles
Dim objRecentFile As Excel.RecentFile
Dim intRecentFileCount As Integer
Dim intCounter As Integer
Set collRecentFiles = Application.RecentFiles
intRecentFileCount = collRecentFiles.Count
For intCounter = 1 To intRecentFileCount
Set objRecentFile = collRecentFiles(intCounter)
If objRecentFile.Name = strFileName Then
objRecentFile.Delete
Exit For
End If
Next intCounter
End Sub

Answer 2

Thanks to Robin the working solution is as follows:
Updated intial code:
Sub incrementSaveAs()
'to avoid that other workbooks are saved (when assigned to shortkey control-S)
If ActiveWorkbook.Name <> ThisWorkbook.Name Then ActiveWorkbook.Save: Exit Sub
Dim newFilename As String
Dim oldFilename As String
oldFilename = ActiveWorkbook.Name
newFilename = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)
If IsNumeric(Right(newFilename, 1)) = True Then
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path + "\" + newFilename & "a.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False, AddToMru:=True
'AddToMru:=True Added to update recent files history
Else
If Right(newFilename, 1) = "z" Then
MsgBox "'z' reached, please save as new version"
Exit Sub
End If
newFilename = Left(newFilename, Len(newFilename) - 1) & Chr(Asc(Right(newFilename, 1)) + 1)
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path + "\" + newFilename & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False, AddToMru:=True
End If
RemoveRecentFile (ActiveWorkbook.Path & Application.PathSeparator & oldFilename)
End Sub
Updated Robin's code:
Public Sub RemoveRecentFile(strPathAndFileName As String)
Dim collRecentFiles As Excel.RecentFiles
Dim objRecentFile As Excel.RecentFile
Dim intRecentFileCount As Integer
Dim intCounter As Integer
Set collRecentFiles = Application.RecentFiles
intRecentFileCount = collRecentFiles.Count
For intCounter = 1 To intRecentFileCount
Set objRecentFile = collRecentFiles(intCounter)
If objRecentFile.Path = strPathAndFileName Then
objRecentFile.Delete
Exit For
End If
Next intCounter
End Sub