Saving new Excel document as macro-free workbook without prompt - vba

Question

I'm using Excel 2010. I have an Excel macro-enabled template that has a data connection to a text file that is set to automatically refresh when a new document is created using this template.
The following macro is within the "ThisWorkbook" object to remove the data connection before saving the new document:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Do While ActiveWorkbook.Connections.Count > 0
ActiveWorkbook.Connections.Item(ActiveWorkbook.Connections.Count).Delete
Loop
End Sub
When a user clicks the save icon / hits ctrl+S, inputs a filename and then clicks save to save as a macro-free Excel workbook (as is the default and required filetype) they are prompted with a message stating:
The following features cannot be saved in macro-free workbooks:
• VB project
To save a file with these features, click No, and then choose a
macro-enabled file type in the File Type list.
To continue saving as a macro-free workbook, click Yes.
Is it possible to prevent this message from appearing and have Excel assume that the user wants to continue with a macro-free workbook?
I've searched all over and understand that I may be able to add code to the workbook object that removes itself so that Excel has no VB project to cause this message but this would require each user to change Trust Center Settings (Trust access to the VBA project object model) which I want to avoid.
I've also seen suggestions of using:
Application.DisplayAlerts = False
but can't get this to work. Every example of it's use seems to be within a sub that is also handling the saving of the document whereas in my situation the BeforeSave sub ends before the document is saved in the default, non-vba way which is perhaps why it does not work?
Does this property reset to a default True after the sub has ended / before the save actually occurs?
Apologies for any nonsense I may have dispensed, my experience with VBA is very limited.

Answer 1

I cannot test on Excel 2010, but at least for 2016, it's working fine:
Sub SaveAsRegularWorkbook()
Dim wb As Workbook
Dim Path As String
Set wb = ThisWorkbook
Path = "T:\he\Path\you\prefer\"
Application.DisplayAlerts = False
Application.EnableEvents = False
wb.SaveAs Filename:=Path & "Test.xlsx", FileFormat:=51
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
Give it a try.

Answer 2

Different approach... when the template is loaded, require the user to save as (I have a workbook/template with a similar situation...). This should open them up to the user's Documents folder, though you can adjust to save to whatever location.
Inside of the ThisWorkbook module, put:
Option Explicit
Private Sub Workbook_Open()
Dim loc As Variant
Application.DisplayAlerts = False
loc = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Save As...", InitialFileName:="%USERPROFILE%\Documents\NAME_OF_FILE")
If loc <> False Then
ActiveWorkbook.SaveAs Filename:=loc, FileFormat:=51
Exit Sub
End If
Application.DisplayAlerts = True
End Sub
Edit1: Adding the if statement using a base-template name, so subsequent saves do not prompt the save-as:
Option Explicit
Private Sub Workbook_Open()
If ActiveWorkbook.Name = "_NAME_OF_FILE.xlsb" Then
Dim loc As Variant
Application.DisplayAlerts = False
loc = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Save As...", InitialFileName:="%USERPROFILE%\Documents\_NAME_OF_FILE")
If loc <> False Then
ActiveWorkbook.SaveAs Filename:=loc, FileFormat:=51
Exit Sub
End If
Application.DisplayAlerts = True
End If
End Sub

Answer 3

For this answer, I'm assuming that by Excel macro-enabled template, you mean a xltm file. I also guess that what you mean by "new document" is the document that is generated when a user double-clicks on the xtlm file (hence this new file has no location on since it hasn't been saved yet).
To solve your issue, you could use a custom SaveAs window (Application.GetSaveAsFilename) to have more control on how the user saves the file when the Workbook_BeforeSave event macro gets called.
Here is how to implement it:
1 - Copy this code into a new module.
Option Explicit
Sub SaveAsCustomWindow()
Const C_PROC_NAME As String = "SaveAsCustomWindow"
Dim strFullFileName As String, strPreferedFolder As String, strDefaultName As String
Dim UserInput1 As Variant, UserInput2 As Variant
Dim isValidName As Boolean, isFileClosed As Boolean, isWorkbookClosed As Boolean
Dim strFilename As String, strFilePath As String
'To avoid Warning when overwriting
Application.DisplayAlerts = False
'Disable events (mostly for the BeforeSave event) to avoid creating infinite loop
Application.EnableEvents = False
On Error GoTo ErrHandler
'Customizable section
strDefaultName = ThisWorkbook.Name
strPreferedFolder = Environ("USERPROFILE")
Do While isWorkbookClosed = False
Do While isFileClosed = False
Do While isValidName = False
UserInput1 = Application.GetSaveAsFilename(InitialFileName:=strPreferedFolder & "\" & strDefaultName, FileFilter:="Excel Workbook (*.xlsx),*.xlsx")
If UserInput1 = False Then
GoTo ClosingStatements 'This is important to take care of the case when the user presses cancel
Else
strFullFileName = UserInput1
End If
strFilename = Right(strFullFileName, Len(strFullFileName) - InStrRev(strFullFileName, "\"))
strDefaultName = strFilename
strFilePath = Left(strFullFileName, InStrRev(strFullFileName, "\") - 1)
strPreferedFolder = strFilePath
'If the file exist, ask for overwrite permission
If Dir(strFullFileName) <> "" Then
UserInput2 = MsgBox(strFilename & " already exists." & vbNewLine & "Do you want to overwrite?", vbYesNoCancel Or vbExclamation)
If UserInput2 = vbNo Then
isValidName = False
ElseIf UserInput2 = vbYes Then
isValidName = True
ElseIf UserInput2 = vbCancel Then
GoTo ClosingStatements
Else
GoTo ClosingStatements
End If
Else
isValidName = True
End If
Loop
'Check if file is actually open
If isFileOpen(strFullFileName) Then
MsgBox "The workbook you want to overwrite is currently open. Choose a different name, or close the workbook before saving.", vbExclamation
isValidName = False
isFileClosed = False
Else
isFileClosed = True
End If
Loop
'Check if an opened workbook has the same name
If isWorkbookOpen(strFilename) Then
MsgBox "You cannot save this workbook with the same name as another open workbook or add-in. Choose a different name, or close the other workbook or add-in before saving.", vbExclamation
isValidName = False
isFileClosed = False
isWorkbookClosed = False
Else
isWorkbookClosed = True
End If
Loop
ThisWorkbook.SaveAs Filename:=strFullFileName, FileFormat:=xlOpenXMLWorkbook
ClosingStatements:
Application.EnableEvents = True
Application.DisplayAlerts = True
Exit Sub
ErrHandler:
Call MsgBox("Run-time error '" & Err.Number & "': " & Err.Description & vbNewLine & _
"While running: " & C_PROC_NAME & IIf(Erl <> 0, vbNewLine & "Error Line: " & Erl, "")
GoTo ClosingStatements
End Sub
Function isFileOpen(ByVal Filename As String) As Boolean
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open Filename For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: isFileOpen = False
Case 70: isFileOpen = True
End Select
End Function
Function isWorkbookOpen(ByVal Filename As String) As Boolean
Dim wb As Workbook, ErrNo As Long
On Error Resume Next
Set wb = Workbooks(Filename)
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: isWorkbookOpen = True
Case Else: isWorkbookOpen = False
End Select
End Function
Explanation of part 1: This whole thing might seem a bit overkill, but all the error handling is important here to take into account potential errors and make sure that the setting for Application.EnableEvents is turned back to TRUE even if an error occurs. Otherwise, all event macros will be disabled in your Excel application.
2 - Call the SaveAsCustomWindow procedure inside the Workbook_BeforeSave event procedure like this:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Your code
If ThisWorkbook.Path = "" Then
SaveAsCustomWindow
Cancel = True
End If
End Sub
Note that we need to set the variable Cancel = True in order to prevent the default SaveAs window to show up. Also, the if statement is there to make sure that the custom SaveAs window will only be used if the file has never been saved.

Answer 4

To answer your questions:
Is it possible to prevent this message from appearing?
Yes, using the Application.DisplayAlerts property
Is it possible to have Excel assume that the user wants to continue with a macro-free workbook?
No, you have to write the procedure to save the workbook and bypass the SaveAs excel event and save the workbook using the user input (Path & Filename) with the required format.
The following procedure uses a FileDialog to capture the Path and Filename from the user then saves the file without displaying the warning message.
I have added some explanatory comments nevertheless, let me know of any questions you might have.
Copy these procedures in the ThisWorkbook module:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True 'Prevents repetitive Save
Call Workbook_BeforeSave_ApplySettings_And_Save
End Sub
Private Sub Workbook_BeforeSave_ApplySettings_And_Save()
Dim fd As FileDialog, sFilename As String
Rem Sets FileDialog to capture user input
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.InitialView = msoFileDialogViewDetails
.Title = vbNullString 'Resets default value in case it was changed
.ButtonName = vbNullString 'Resets default value in case it was changed
.AllowMultiSelect = False
If .Show = 0 Then Exit Sub 'User pressed the Cancel Button
sFilename = .SelectedItems(1)
End With
With ThisWorkbook
Do While .Connections.Count > 0
.Connections.Item(.Connections.Count).Delete
Loop
Application.EnableEvents = False 'Prevents repetition of the Workbook_BeforeSave event
Application.DisplayAlerts = False 'Prevents Display of the warning message
On Error Resume Next 'Prevents Events and Display staying disable in case of error
.SaveAs Filename:=sFilename, FileFormat:=xlOpenXMLWorkbook 'Saves Template as standard excel using user input
If Err.Number <> 0 Then
MsgBox "Run-time error " & Err.Number & String(2, vbLf) _
& Err.Description & String(2, vbLf) _
& vbTab & "Process will be cancelled.", _
vbOKOnly, "Microsoft Visual Basic"
End If
On Error GoTo 0
Application.DisplayAlerts = True
Application.EnableEvents = True
End With
End Sub