Conquering SaveAs in VBA - File Picker (Filedialog), Overwrite Files, Yes No Option - CODE INCLUDED

Опубликовано: 06 Октябрь 2024
на канале: EverydayVBA

5,305

Conquering SaveAs in VBA - Overwrite Files, Yes No Option

**Get the Excel file here
https://chrisjterrell.com/blog/225118...
Grab the Free VBA Quick Reference Guide
https://www.chrisjterrell.com/excel-v...

First thing first, let's create a Runtime 1004. It is pain and it is very important because we will deal with it later in the video.

How do you overwrite a file using SaveAs. It is easy using "Application.DisplayAlerts = False". Using this method will allow you to save a file without the warning that asks if you want to save a file.

In the next macro, we use a file dialog to allow the user to select the file's correct file path and name. We use an if statement to check to see if the user selected Cancel. If Cancel is selected, the variable will equal False. If this happens, we exit the subprocedure. We then use the "Dir" function to see if the file exists. If the file doesn't exist, it will return a double quote, and we save the file.
However, if the file does exist, we use a message box to determine the next steps. If the user selects "Yes," we overwrite the file. If they select "No," we return the user to the filedailog. Finally, if they select "Canel," we exit the sub.

The last macro does an autosave with a timestamp. People have asked me how to do this, and this code is the solution. The complexity is stripping the destination string of its extension, adding a date and time, and then appending it. In this case, we hard code the .xlsm extension.

'----------------- CODE ----------------------
Sub Runtime1004()
'This makes a simple change to the workbook so Excel will show a Save Warning
Range("A1") = "Make change so Excel will show Save warning"

'Click NO or cancel to get a Runtime 1004
ActiveWorkbook.SaveAs ActiveWorkbook.FullName

End Sub

Sub ExcelVBACheckPath()
Range("A1") = "Make change so Excel will show Save warning"

filename = ThisWorkbook.Path
Debug.Print filename
filename = filename & "\FileWithoutWarning.xlsm"
Debug.Print filename

'Check if the file exists.
fle = Dir(filename)
If Dir(filename) [equal to] "" Then
MsgBox "File Exists"
Exit Sub
End If

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs filename
Application.DisplayAlerts = True
End Sub

Sub OverwriteOption()

fileDialog:

filename = Application.GetSaveAsFilename("Default Name of Saved File", _
"Excel Macro Files,*.xlsm", 1, "Save the File")
Debug.Print filename

If filename = False Then
'Senario 1 Cancel is clicked on the File Dialog
Exit Sub
End If

If Dir(filename) = "" Then
'Senerio 2 Duplicate File doesn't exist
ActiveWorkbook.SaveAs filename
Else
mbox = MsgBox("This File Already Exists. Do you want to Overwrite the file", vbYesNoCancel)
If mbox = vbYes Then
'Senerio 3 Overwrite the File - Without warnings
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs filename
Application.DisplayAlerts = True
ElseIf mbox = vbNo Then
'Senerio 4 Don't Overwrite - Send back to the File Dialog
GoTo fileDialog
Else
'Senerio 5 Cancel on the Message box exits sub
Exit Sub
End If

End If

End Sub

Sub SaveASwithTimestamp()

filename = ThisWorkbook.FullName

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
'Get File Extension
ext = fso.GetExtensionName(filename) 'This gets the Extension

filenameNoExt = Left(filename, Len(filename) - Len(ext) - 1)
Debug.Print filenameNoExt

dte = Format(Date, "yyyy-mm-dd")
tme = Format(Time, "hh mm.ss")

ActiveWorkbook.SaveAs filenameNoExt & " " & dte & " " & tme & ".xlsm", 52

End Sub