Handling save error messages using VBA - excel

I have the following macro to auto save a workbook:
ActiveWorkbook.SaveAs Filename:=Workbooks(2).Path & "\" & ActiveWorkbook.Name
ActiveWorkbook.Close savechanges:=True
but the problem I have if the destination folder already has file with this name I get a message from Excel saying that this file already exists and whether I want to replace it.
What I need is the following:
if user selects Yes, then replace the existing file
if user selects No (currently I get a runtime error), then it saves it with V2 at the end of the file name, if this exists then V3 and so on
if user selects Cancel, then they see a message saying Are you sure you want to cancel. If they confirm then it's cancelled, otherwise it returns to the error message.
Or perhaps the code can be edited so that when it saves as it checks if file already exists in folder and if it does, then save it as v2.

You would probably have to refactor your current code to use it 'as-is' - but I think this is the logic that you are looking for:
Dim saveName As Variant
retry:
saveName = Application.GetSaveAsFileName
If Not saveName = False Then
If Len(Dir$(saveName)) = 0 Then
ActiveWorkbook.SaveAs saveName
Else
MsgBox "Workbook already exists, please choose a different name.", vbOkOnly
GoTo retry:
End If
Else
MsgBox "User cancelled save.", vbInformation"
End If

Something like
If Dir(strfilename) = "" Then
Else
strfilename=Application.GetSaveAsFilename
End If
ActiveWorkbook.SaveAs strfilename, XlFileFormat.xlOpenXMLWorkbookMacroEnabled

Related

VBA - change directory folder with a cells value name

I made a worksheet with some buttons to save, save as and print quickly, but when a I Save As is saving on the Google Drive folder because is where the current file is, but i want to save on desktop and I can't find a way to make this change directory without break the name of the file. I make the file auto rename to a value of two cells (B10 and B15) when Save As, but when i make the directory change with some ways I found on the internet, doesn't work. I cant make the name and the directory right without a error.
My current code:
Sub SaveAs()
On Error GoTo ErrorSaveAs
Dim ClientName
ClientName = Range("B10").Value & " - " & Range("B15").Value
ActiveWorkbook.SaveAs FileName:="ClientName", FileFormat:=xlOpenXMLWorkbookMacroEnabled
MsgBox "O arquivo foi salvo no seu Desktop.", vbVertical, "Sucesso! - Garage Audax" 'Success message after saving it
Exit Sub
ErrorSaveAs: MsgBox "Ocorreu um erro. Revise as informações e tente novamente.", vbVertical, "Ops! - Garage Audax" 'Error message in case of any error
End Sub
You can get the current user path folder and add the desktop and join the desktop and file name.
Dim desktopFolder as string
desktopFolder = vba.environ("USERPROFILE") & "\Desktop\myFile.xlsm"
I dont think your script was saving because you initially did not specify a file path in the .saveas method.
if you see on the script below. I added fpath variable (with wb.path), so the script stores the filepath of where the activeworkbook is currently saved. (if you did not save the excel file prior executing the script, the .Path property will return blank)
when you use .saveas method, now the fpath variable will tell the computer where to save the file.
if you want to change the file name, just change the "Client Name". The script below will save the file named as "Client Name" as it was originally written on your script.
Let me know if the script works, otherwise lets try to solve it!
Sub SaveAs()
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wb As Workbook
Dim fPath As String
Set wb = ThisWorkbook
fPath = wb.Path & "\"
On Error GoTo ErrorSaveAs
ActiveWorkbook.SaveAs Filename:=fPath & "ClientName", FileFormat:=xlOpenXMLWorkbookMacroEnabled
MsgBox "O arquivo foi salvo no seu Desktop.", vbVertical, "Sucesso! - Garage Audax" 'Success message after saving it
Exit Sub
ErrorSaveAs: MsgBox "Ocorreu um erro. Revise as informações e tente novamente.", vbVertical, "Ops! - Garage Audax" 'Error message in case of any error
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Error - Can't execute in break mode - VBA

Thanks for everyone that answers questions on here. I use this site all the time. I'm not formally trained but have put together some stuff in the past.
Here is what my Code accomplishes. I have a macro enabled excel file that I store in SharePoint. My users edit the excel and run a macro that saves their changes into a CSV File that we use to Import into JIRA. I've been able to create the macro to do all this and it works great when I used it. But when others in my group use it they are getting a "Can't execute in break mode" error. I think I'm missing some validation code but I'm not sure how to achieve this. Any help would be greatly appreciated! I'm so close!!
'''
Sub Save_CSV_Debugger()
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Sheet1")
'Makes a copy of the Worksheet
ws.Copy
'Creates New FileName - Concatenates username and Desktop path with for
New Name
NewName = Environ("USERPROFILE") & "\Desktop\" & Range("A2").Value & " -
JIRA Import" & ".CSV"
Application.DisplayAlerts = False
'Saves WB with NewFileName
ActiveWorkbook.SaveAs Filename:=NewName, _
FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = True
'Hides saves dialog
If SaveAsUI = True Then Cancel = True
' Shows user a message
MsgBox "File saved to Desktop for JIRA Import " & vbNewLine & NewName
ActiveWorkbook.Close
'Reopens CSV File Without Macro - Clean CSV
Application.Workbooks.Open (NewName)
End Sub
'''

Save a copy of a file in a specific folder on opening the file

I have an Excel workbook that is used by a lot of people and can easily be ruined.
How can I by opening the Excel workbook (file) automatically save a copy to a specific folder?
The Excel workbook is in SharePoint so I can create a new folder in the same location with the name 'Archive' and by opening the file a new copy of that file with the same name + "DD.MM.YYY HH:MM:SS" will be saved here.
I'm not sure about sharepoint, but this work if the file is saved in a regular folder. Solution could be made in different ways.
Save the code in the following place in the VBA Editor. Name the sub to "Private Sub Workbook_Open()" - to indicate that excel should execute the code when it opens up.
You can see that you have succeed when the "procedure" field changes to "Open", marked yellow in the picture.
Alternative 1:
Here I hardcode my path by writing "G:\Till\". Then I proceed with adding the timestamp and choose which format. Notice for time you can't use the semicolon ":" in the path. One way is to add "T" for Time and then the hour+minute+second.
In my example code the result will be: "Data Example - 2019-11-03 T203533.xlsm"
Notice that this code will get a Error 1004, if the path doesn't exist.
Private Sub Workbook_Open()
Dim Fldr As String
Application.DisplayAlerts = False 'Hide any save window pop-up
ActiveWorkbook.SaveCopyAs Filename:="G:\Till\" & "Data Example - " & Format(Now(), "yyyy-MM-dd Thhmmss") & ".xlsm" 'Save the workbook as a copy of the original. Add Hour and timestamp
Application.DisplayAlerts = True
End Sub
Alternative 2:
To make the code more robust I check the pathway of the workbook I use and then check if the folder "Archive" exists. If it doesn't exist it will create the folder and save a copy of the file.
Private Sub Workbook_Open()
Dim Fldr As String
Application.DisplayAlerts = False 'Hide any save window pop-up
Fldr = Dir(Application.ActiveWorkbook.Path & "\Archive\", vbDirectory) 'Check if folder exists. The variable will be empty if no folder exists.
If Fldr = Empty Then 'If no folder exist, the variable "Folder"
MkDir Application.ActiveWorkbook.Path & "\Archive\" 'Create the folder
End If
ActiveWorkbook.SaveCopyAs Filename:=Application.ActiveWorkbook.Path & "\Archive\" & "Data Example - " & Format(Now(), "yyyy-MM-dd Thhmmss") & ".xlsm"
Application.DisplayAlerts = True
End Sub

Returning a message instead a error in case of opening a excel workbook with wrong filename

Inside an excel macro I have a command that opens an external workbook:
Workbooks.Open (directory & filename), ReadOnly:=True
I want that in the case the filename does not exist or has a different name from the specified in the macro, to present a message box with a customized message to the user (i.e. "the filename does not exist or has a different name"), instead the defined application error:
"`Runtime error 1004... Microsoft Excel cannot access...."
How can I archieve this?
You can test for the existence of the file by using Dir()
Sub OpenTester()
Dim v As String
directory = "C:\TestFolder\"
fiilename = "ABZ.xls"
v = directory & fiilename
If Dir(v) = "" Then
MsgBox "Warning Will Robinson, warning!"
Else
Workbooks.Open (v), ReadOnly:=True
End If
End Sub
You can try something like this:
Sub OpenFileSub()
On Error GoTo ErrHandler
Workbooks.Open (directory & Filename), ReadOnly:=True
On Error GoTo 0
ErrHandler:
MsgBox "the filename does not exist or has a different name"
End Sub

Save Workbook in current directory with title from cell

I download files where I need to rename them based on the name contained in cell A1. The file is already saved in the current directory, so what I am after is only to save to the current directory with the filename in call A1 and the extension ".xls"
Tried this code:
Sub SaveToRelativePath()
Dim relativePath As String, sname As String
sname = ActiveWorkbook.Worksheets(1).Range("A1") & ".xls"
relativePath = Application.ActiveWorkbook.Path & "\" & sname
ActiveWorkbook.SaveAs Filename:=relativePath
End Sub
But the debugger reports an error on the last line: ActiveWorkbook.SaveAs Filename:=relativePath
Any clues to how this could be done?
The error is not specified, but in case you see:
It means you try to save a workbook with the above code as "XLS" (actually, not exactly, see below) - and that means a macro-free format. Excel warns you you'll lose the code.
One more issue - regardless of extension you code will save the book as default format for the Excel version you use (and that is XLSX or xlOpenXMLWorkbook for 2007 and perhaps future versions, I have 2007). As a result, you'll get on the saved file opening something like that:
Solutions:
To avoid the 1st warning - save your initial workbook (i.e. that one where you keep the VBA code) as Macro-Enabled before running the macro.
Add proper format description to Save method - in your case that will be FileFormat:=xlExcel8 - thus you'll get true XLS.
One more thing - to avoid aby compatibility alerts when saving file as XLS, add the .CheckCompatibility = False before saving. resulting code should be smth like that:
Sub SaveToRelativePath()
Dim relativePath As String, sname As String
sname = ActiveWorkbook.Worksheets(1).Range("A1") & ".xls"
relativePath = Application.ActiveWorkbook.Path & "\" & sname
Application.DisplayAlerts = False
ActiveWorkbook.CheckCompatibility = False
ActiveWorkbook.SaveAs Filename:=relativePath, FileFormat:=xlExcel8
Application.DisplayAlerts = True
End Sub
However be careful - such construction will silently overwrite any existing file. Hope that was somehow helpful.

Resources