VBA - change directory folder with a cells value name - excel

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

Related

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
'''

Saveas function excel. with name from cell

I am trying to make the following code work for saving a file name in a certain format. I would like it to save in the folder the file was opened up in. the file would change it's name to a new month name. I have got most of it working, such as directory selection and filename and for it to save, however, if there is already a file with the same name or if someone selects no or cancel it gives an error. I have tried various ways of trying to get around it but now I'm at a loss. I have 2 codes they both are supposed to do the same thing, just variations.
Sub saving1()
' Saves the file under a new name based on the new month date.
Dim NewFilename As String
Dim tempnm
Dim loc ' variable for file location
loc = Application.ThisWorkbook.Path 'loads the file location on the loc variable
MsgBox loc
' creates the file name for saving includes the current path.
NewFilename = loc + "\" + Range("NewFileName").Value & ".xlsm"
'tempmm = Application.GetSaveAsFilename initialfilename
ActiveWorkbook.SaveAs NewFilename, FileFormat:=52
'Application.DisplayAlert = False
'On Error Resume Next 'to omit error when cancel is pressed
' MsgBox "Not saved"
'ActiveWorkbook.Save
'If Err.Number <> 1004 Then 'optional, to confirmed that is not saved
' MsgBox "Not saved"
'End If
' On Error GoTo 0 'to return standard error operation
End Sub
Sub saving()
' Saves the file under a new name based on the new month date.
Dim NewFilename As String
Dim loc ' variable for file location
loc = Application.ThisWorkbook.Path 'loads the file location on the loc variable
' creates the file name for saving includes the current path.
NewFilename = loc + "\" + Range("NewFileName").Value & ".xlsm"
ActiveWorkbook.SaveAs NewFilename, FileFormat:=52
End Sub
I also added message boxes to try see what it is doing during testing. I have also tried the Getsaveasfilename in order to give the user an option to choose his/her own filename and possibly folder. The file location will change once a year.
If Your are looking at overwriting existing file, when there's already a file with same name try below.
NewFilename = loc + "\" + Range("NewFileName").Value & ".xlsm"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs NewFilename, FileFormat:=52
Application.DisplayAlerts = True

Handling save error messages using VBA

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

Save numbered versions of excel files based on folder contents

I need code that saves incrementally numbered versions of a file based on whether similarly named files already exist in a specified folder.
For example,
Check for the prescence of currently open file, say named
"Inv_Dec_2015.xlsx" in a folder named "Reports".
If file exists, check for "Inv_Dec_2015_v1.xlsx" in "Reports".
If file exists, check for "Inv_Dec_2015_v2.xlsx" in "Reports".
If file exists, check for "Inv_Dec_2015_v3.xlsx" in "Reports".
If file does NOT exist, Save currently open file as "Inv_Dec_2015_v3.xlsx"
and so on till any number of versions......
I found the following two pieces of code on Ron de Bruin's website that can be used for something like this and modified it a bit to my purpose, but I don't know how use it to check for pre-existing files.
Would deeply appreciate any help with this.
Sub Rename_Store_Wbk()
Dim sPath As String
' Enter the path at which file is to be stored
sPath = ActiveSheet.Range("K1").Value & ActiveSheet.Range("K2").Value & ".xlsx"
' Check whether the file already exists by calling the FileExist function
If FileExist(sPath) = False Then
ActiveWorkbook.SaveAs Filename:=sPath, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End If
End Sub
Function FileExist(FilePath As String) As Boolean
Dim TestStr As String
'Test File Path (ie "C:\Users\Chris\Reports\Inv_Dec_2015.xlsm")
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0
'Determine if File exists
If TestStr = "" Then
FileExist = False
Else
FileExist = True
End If
End Function
See if the loop I added in here works for you:
Sub Rename_Store_Wbk()
Dim sPath As String
' Enter the path at which file is to be stored
sPath = ActiveSheet.Range("K1").Value & ActiveSheet.Range("K2").Value & ".xlsx"
If Not FileExists(sPath) Then
i = 1
Do
sPath = Left(sPath, Len(sPath) - 5) & "_v" & i & ".xlsx"
i = i + 1
Loop Until FileExists(sPath)
End If
ActiveWorkbook.SaveAs Filename:=sPath, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
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

Resources