Excel VBA to save workbook as macro free

Question

Hi All,

I have below code to save workbook as only xlsx format which works fine but it always ask whether to save a workbook macro free or not. I can suppress this message by setting the warning message off but than if file with same name already exist in the location than it overrites it.

How shall i suppress the message box of saving the file as macro free or macro enable but still pop up the message box if file with same name already exist?

ActiveWorkbook.SaveAs Application.GetSaveAsFilename(NewWbName, FileFilter:= _
    "Excel Files (*.xlsx)," & "*.xlsx")

Thanks,

Zav

Answer 1

Use code to search for the file name with Dir function as per the following example.

Sub SaveAsTest()
    Dim NewWbName As String
    Dim msgResponse
   
    NewWbName = ThisWorkbook.Path & "\My New FileName"
   
    If Dir(NewWbName & ".xlsx") <> "" Then  'NOT equal to zero length string then file exists
        msgResponse = MsgBox("FileName " & NewWbName & ".xlsx" & " already exists." & vbCrLf & _
                "Confirm to overwrite.", vbYesNo)
               
        If msgResponse = vbNo Then
            MsgBox "File already exists. User cancelled save. Processing terminated."
            Exit Sub
        End If
    End If
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:= _
        NewWbName, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
   
End Sub

---

Regards, OssieMac

Answer 2

>>>How shall i suppress the message box of saving the file as macro free or macro enable but still pop up the message box if file with same name already exist?

According to your description, you could use FileFormat optional parameter to specify the file format to use when you save the file, you could modify like below:

ActiveWorkbook.SaveAs Application.GetSaveAsFilename(NewWbName, FileFilter:= _
    "Excel Files (*.xlsm)," & "*.xlsm"), FileFormat:=52

For more information, click here to refer about XlFileFormat Enumeration (Excel)

Answer 3

Thanks for the response. I am having some issue with the code. Below is the complete code.

sub Test1()
Application.DisplayAlerts = false

ActiveWorkbook.SaveAs Application.GetSaveAsFilename(NewWbName, FileFilter:= _
    "Excel Files (*.xlsx)," & "*.xlsx")
    
    SaveAsTest
    
    Application.DisplayAlerts = True

End Sub


Sub SaveAsTest()
    Dim NewWbName As String
    Dim msgResponse
    
   
    NewWbName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
   
    If Dir(NewWbName & ".xlsx") <> "" Then  'NOT equal to zero length string then file exists
        msgResponse = MsgBox("FileName " & NewWbName & ".xlsx" & " already exists." & vbCrLf & _
                "Confirm to overwrite.", vbYesNo)
               
        If msgResponse = vbNo Then
            MsgBox "File already exists. User cancelled save. Processing terminated."
            Exit Sub
        End If
    End If
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:= _
        NewWbName, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
   
End Sub

My test1 procedure opens the file dialog box and if i select to save the file on my desktop where duplicate file already exist still it over rites the file and my file is saved. Your procedure save as test than checks the dir for the same file name and even that do not find the duplicate file on my deskotp but file is there already.

What i am doing wrong?

Answer 4

Hi, zaveri cc

According to your description, I have reproduce this issue using your sample codes, This issue is cause by that ActiveWorkbook.Name has fils extension ".xlsx" after you have saved it. So I suggest that you could modify like below：

NewWbName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
   
If Dir(NewWbName) <> "" Then  'NOT equal to zero length string then file exists

......

End If

Answer 5

Hi David,

I still have the issue. Let me explain the entire issue.

Using code in workbook1, i am creating another workbook "TempWb" by copying few sheets (having code) from wb1. I want to save tempwb as macro free workbook so Using getsaveasfilename method, i am opening the file dialogue box with default file name TempWb and defualt file extension to .xlsx files. 

I am setting display alerts to false so that excel do not ask me whether to save wb as macro enable or macro free. As warings is turned off my below code overrites the existing excel file without any warnings if file with same name exist. so i need code to be triggered as soon as user clicks on save button. Below is my complete code

NewWbName= some other code to get the workbookname 
ActiveWorkbook.SaveAs Application.GetSaveAsFilename(NewWbName, FileFilter:= _
    "Excel Files (*.xlsx)," & "*.xlsx")
NewWbName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
   
If Dir(NewWbName) <> "" Then  'NOT equal to zero length string then file exists

msgbox "FILE EXISTS"

End If

The above code overrites the file and than dir(newwbname) checks if file exist. Ideally, Once the user click on save button, code shall check whether file with same name exist and if yes than it shall show msgbox "file exist, do you want to overrite the file or change the file name"

User can choose to save file at any location.

Also, in above code if i decide not to save the file by clicking on cancel button that file name changes to False.xlsx

Thanks,

Zav

Answer 6

Your current issue is "ActiveWorkbook.SaveAs Application.GetSaveAsFilename"
You are saving it as right then and there. Instead assign the GetSaveAsFilename to a variable to test.

EDIT: OssieMac's original response is correct, but you appear to want to give the user the ability to name the file, but not allow an overwrite. Because you put the Application.GetSaveAsFilename after the Application.SaveAs, Excel initiates the save on that line. Also Excel interprets the False state (from your Cancel) as "False" and saves accordingly when you click cancel in your version.

Try something like:

  DfltNewWbName = Application.ActiveWorkbook.Path & "\DefaultName.xlsx"
  NewWbName = Application.GetSaveAsFilename(InitialFileName:=DfltNewWbName , fileFilter:="Excel Files (*.xlsx), *.xlsx")
  If NewWbName = "" Then
  Else
	If Dir(NewWbName) <> "" Then  'NOT equal to zero length string then file exists
		msgbox "FILE EXISTS"
	Else
		ActiveWorkbook.SaveAs NewWbName  'THEN SAVE
	End If	
  End If

Sorry if that's a red herring, I'm kinda newb.

Answer 7

Hi John,

The code works well but if i click on cancel button instead of save button than it throws error "Type mismatch". Also, is it possible to code messagebox "File with same name exist. Do you want to overrite it?" if user selects yes than code shall override the file and save it.

Thanks,

Zav

Answer 8

>>>The code works well but if i click on cancel button instead of save button than it throws error "Type mismatch". Also, is it possible to code messagebox "File with same name exist. Do you want to overrite it?" if user selects yes than code shall override the file and save it.

According to your description, you could refer to below code, then modify these codes based on your real requirements:

Application.DisplayAlerts = False
       
NewWbName = = some other code to get the workbookname     
fileSaveName = Application.GetSaveAsFilename(NewWbName, FileFilter:= _
        "Excel Files (*.xlsx)," & "*.xlsx")
    
If fileSaveName <> False Then
   ActiveWorkbook.SaveAs fileSaveName
End If
    
NewWbName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
       
If Dir(NewWbName) <> "" Then  'NOT equal to zero length string then file exists
   msgResponse = MsgBox("FileName " & NewWbName & " already exists." & vbCrLf & _
                 "Confirm to overwrite.", vbYesNo)
   If msgResponse = vbNo Then
        MsgBox "File already exists. User cancelled save. Processing terminated."
        Exit Sub
   Else    
        ActiveWorkbook.Save       
   End If    
End If
Application.DisplayAlerts = True