Save Workbook in current directory with title from cell - excel

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.

Related

Excel VBA won't save: creating 8-digit alphanumeric "filename"

I am new to VBA. I am using a "shell" macro to run another macro on a series of files. It won't save. I am going to include my code here and also a series of photos because the photos were the only way to show the result of hovering over the values in the code.
So, the error message is generating something I don't understand. But it is clear that the links in the code link to what the results should be, so I'm confused.
This is the code:
Sub SHELLforMacros()
Dim wbMatrix As Workbook
Dim strFileName As String
Dim strFileName As String
Dim newFileName As String
Dim strPath As String
Dim strExt As String
Dim objWorkbook As Workbook
Dim ws As Worksheet
Dim Sheetname As Worksheet
Set Sheetname = Worksheets(1)
Dim Worksheet As Worksheet
Dim rng As Range
Set rng = Range("A2")
strPath = "C:\Users\myname\Desktop\All_mricgcm3_files\45\Fall45\test\"
strExt = "csv"
strFileName = Dir(strPath & "*." & strExt)
While strFileName <> ""
Set wbMatrix = Workbooks.Open(strPath & strFileName)
Application.Run "'C:\Users\myname\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB'!Graph_NEW"
strPath = "C:\Users\myname\All_mricgcm3_files\45\Fall45\test\"
newFileName = Sheetname.Range("A2").Value
ActiveWorkbook.SaveAs fileName:=strPath & newFileName, FileFormat:=51
ActiveWorkbook.Close SaveChanges:=True
Wend
End Sub
What this macro is supposed to do is open a file, run another macro on the file (creating a graph), and then save the file with the same name but as an .xlsx file. Then open the next file in the folder and do the same, until it runs out of files. I realize the code may not be the most current. It is cobbled together from things I've found online. Thanks for any help.
Edit: UPDATE - I removed all the section on saving and closing the file from the "shell" macro and put it into the "Graph_NEW" macro. Now the "shell" macro is running fine. But I am running into the same issue with the "Graph_NEW" macro now. It is exactly the same error message as highlighted in the first image, only each time there is a new 8-digit alphanumeric "filename" that it is looking for. This seems like a very specific thing.
I changed the section in the following ways, successively, in an attempt to debug. I added With and End With around the section:
With WB
ActiveWorkbook.Save
newFileName = Sheetname.Range("A2").Value
strPath = "C:\Users\qmontana\All_mricgcm3_files\mric45\Fall45\test\"
ActiveWorkbook.SaveAs fileName:=strPath & newFileName & ".xlsx", FileFormat:=51
ActiveWorkbook.Close SaveChanges:=True
End With
I changed the name of the folder from "45" to "mric45" thinking that maybe it didn't like a number as a folder name.
I removed the "backslash" at the end of the strPath--and then the 8-digit alphanumeric string showed up as an error after the Fall45 folder, like this "C:\Users\myname\Desktop\All_mricgcm3_files\45\Fall45\777GTY78". Yet, as I've shown in the images, all indications are that it knows what file it is working with. There are no "blank spaces" in the pathname.
I tried taking the underscores out of the folder "All_mricgcm3_files".
I moved the line newFileName = Sheetname.Range("A2").Value to come before the strPath line.
Where is this 8-digit alphanumeric "filename" coming from?? (See error code, first image.)
Ok, it was a very simple thing, in case anyone else runs into this problem.
Took me two days to find out though --> I had somehow dropped a folder layer in the path name. The catch? The alphanumeric string was showing up at the end of the path name, not where the folder layer was missing. That's why I was thrown off because my focus was on the ending.
When I added that folder\ back in, I had no more problem with saving and the macro ran fine.

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

Saving a macro so that the file can be updated

Background Information - I have two buttons, that both run a set of code. The excel file has over 30 columns and 65,000 rows. This file is exported (.csv) from somewhere and is updated biweekly.
Goal - have the new file saved with the same name as the old. So that the values can be updated, buttons are still available and the code can run again with the new file.
Or That when a new file is exported, it is saved in a folder that runs the code INDEPENDENT of the user path. i.e Pathname = ActiveWorkbook.Path & "C:\Users\"this can be any name"\Desktop\Downloads\"
Attempt
Used a similar code to the one in a previous question "Run same excel macro on multiple excel files" with edits to tailor for my code. With no success
Sub ProcessFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = ActiveWorkbook.Path & "\Files\"
Filename = Dir(Pathname & "*.xls")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
DoWork wb
wb.Close SaveChanges:=True
Filename = Dir()
Loop
End Sub
Currently, when I attempt the first method I only replace (Old file + VBA) with (New file).
Please note that the solution does not need to be a VBA code. If it's just saving the file in a new method that stores the macro and updates the values I would be happy.
An example of my previous answer:
Sub SaveThisAs()
Dim wb As Workbook: Set wb = ThisWorkbook 'ThisWorkbook referrs to the workbook the macro is ran from
Dim PathToSaveTo As String
PathToSaveTo = wb.Path & "\"
PathToSaveTo = PathToSaveTo & Format(Now, "ddMMyyyy_hhmmss") & wb.Name 'Lets add a timestamp
'Do your macro stuff here
'....
'Save the workbook
wb.SaveAs PathToSaveTo
End Sub
Please note that I'm using wb.Name at the end of the file to save to... this will be fine first time you run this, but a second time the name will get longer... and longer ... and longer. Adjust as per your needs with an appropriate file name.

SaveAs OK in excel 2013 but ignores filename in 2003

I have a code in excel VBA that saves a workbook with a coded path and filename which works perfectly on my computer at home running windows 8 and office 2013.
When I try to use it on my work computer which runs windows XP and office 2003 it ignores the coded path and file name and opens the save as dialogue box which defaults to the My Documents directory.
The intent is for the users at work to click save and the file will automatically go to a network drive with a personalised filename. They should not have to select a path or filename.
I have been testing with the path C:\Temp\ and saving a plain .XLS file which should work on both versions of Excel.
I tried it without disabling alerts and it gave no clues as to why it ignores the path and filename. I have also tried fileformat:=xlnormal etc. with no luck.
Why is this happening and how do I fix it?
Here is the code:
Sub FeedBackSave()
' Save the Feedback worksheet created by the user to the network drive using the path copied from
' the Management workhseet cell A11, the resource name copied from cell A1 and todays date as the filename.
Dim wsh As Worksheet
Dim nme, pth, TodaysDate As String
TodaysDate = format(Now, "dd-mm-yy")
nme = Range("A1").Value
pth = Worksheets("Management").Range("A11").Value
Application.ScreenUpdating = False
Application.DisplayAlerts = False ' Prevents alerts like incorrect file type or overwrite file y/n to permit 1 click save
'Save Feedback worksheet
ActiveWorkbook.Close SaveChanges:=True, Filename:=pth & "FeedBack " & nme & " " & TodaysDate & ".xls"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Saveas Before you close the workbook, might help., check the ranges, not sure if they are on the same sheet or not.
Sub FeedBackSave()
' Save the Feedback worksheet created by the user to the network drive using the path copied from
' the Management workhseet cell A11, the resource name copied from cell A1 and todays date as the filename.
Dim wsh As Worksheet
Dim nme As String, pth As String, TodaysDate As String, FName As String
Set ws = Worksheets("Management")
TodaysDate = Format(Now, "dd-mm-yy")
nme = Range("A1").Value
pth = ws.Range("A11").Value
FName = pth & nme & "-" & TodaysDate & ".xls"
Application.DisplayAlerts = 0
With ActiveWorkbook
.SaveAs FileName:=FName
.Close
End With
End Sub

How to do a "Save As" in vba code, saving my current Excel workbook with datestamp?

I have an Excel Workbook that on form button click I want to save a copy of the workbook with the filename being the current date.
I keep trying the the following
ActiveWorkbook.SaveAs ("\\filePath\FormFlow To MSExcel\" & Left(Now(), 10)) but am receiving Run-time error '1004': Method 'SaveAs' of object'_Workbook' failed.
Can anyone assist me with this? I'm still very new to developing for Excel.
Most likely the path you are trying to access does not exist. It seems you are trying to save to a relative location and you do not have an file extension in that string. If you need to use relative paths you can parse the path from ActiveWorkbook.FullName
EDIT:
Better syntax would also be
ActiveWorkbook.SaveAs Filename:=myFileName, FileFormat:=xlWorkbookNormal
Easiest way to use this function is to start by 'Recording a Macro'. Once you start recording, save the file to the location you want, with the name you want, and then of course set the file type, most likely 'Excel Macro Enabled Workbook' ~ 'XLSM'
Stop recording and you can start inspecting your code.
I wrote the code below which allows you to save a workbook using the path where the file was originally located, naming it as "Event [date in cell "A1"]"
Option Explicit
Sub SaveFile()
Dim fdate As Date
Dim fname As String
Dim path As String
fdate = Range("A1").Value
path = Application.ActiveWorkbook.path
If fdate > 0 Then
fname = "Event " & fdate
Application.ActiveWorkbook.SaveAs Filename:=path & "\" & fname, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Else
MsgBox "Chose a date for the event", vbOKOnly
End If
End Sub
Copy the code into a new module and then write a date in cell "A1" e.g. 01-01-2016 -> assign the sub to a button and run. [Note] you need to make a save file before this script will work, because a new workbook is saved to the default autosave location!
It could be that your default format doesn't match the file extension. You should specify the file format along with the filename, making sure the format matches the extension:
With someWorkbook
.SaveAs "C:\someDirector\Awesome.xlsm", fileformat:=xlOpenXMLWorkbookMacroEnabled
End With
OTOH, I don't see an extension on your .SaveAs filename. Maybe you need to supply one when doing this programmatically. That makes sense--not having to supply an extension from the GUI interface is convenient, but we programmers are expected to write unambiguous code. I suggest adding the extension and the matching format. See this msdn page for a list of file formats. To be honest, I don't recognize a lot o the descripions.
xlExcel8 = 56 is the .xls format
xlExcel12 = 50 is the .xlsb format
xlOpenXMLWorkbook = 51 is the .xlsx format
xlOpenXMLWorkbookMacroEnabled = 52 is the .xlsm format
xlWorkbookDefault is also listed with a value of 51, which puzzles me since I thought the default format could be changed.
I successfully use the following method in one file,
But come up with exactly the same error again...
Only the last line come up with error
Newpath = Mid(ThisWorkbook.FullName, 1, _
Len(ThisWorkbook.FullName) - Len(ThisWorkbook.Name)) & "\" & "ABC - " & Format(Date, "dd-mm-yyyy") & ".xlsm"
ThisWorkbook.SaveAs (Newpath)
I was struggling, but the below worked for me finally!
Dim WB As Workbook
Set WB = Workbooks.Open("\\users\path\Desktop\test.xlsx")
WB.SaveAs fileName:="\\users\path\Desktop\test.xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Dim NuevoLibro As Workbook
Dim NombreLibro As String
NombreLibro = "LibroPrueba"
'---Creamos nuevo libro y lo guardamos
Set NuevoLibro = Workbooks.Add
With NuevoLibro
.SaveAs Filename:=NuevaRuta & NombreLibro, FileFormat:=52
End With
'*****************************
'valores para FileFormat
'.xlsx = 51 '(52 for Mac)
'.xlsm = 52 '(53 for Mac)
'.xlsb = 50 '(51 for Mac)
'.xls = 56 '(57 for Mac)
'*****************************
When working with large amount of data where .xlsx workbook is needed, use the following syntax
ActiveWorkbook.SaveAs Filename:=myFileName, FileFormat:=51
(For more FileFormats see documentation.)
I think your issue was that when you use Now(), the output will be "6/20/2014"... This an issue for a file name as it has "/" in it. As you may know, you cannot use certain symbols in a file name.

Resources