I am trying to save a copy of an excel file through use of a marco but amend text after the current file name when saving. I have a macro that works, but it adds the file extension to the file name before I can amend text to it.
EG- my file is named "MyCurrentFile.xlsm", when I save it it adds the date, but keeps names the file "MyCurrentFile.xlsm01-14-16.xlsm".
Can I somehow remove the first .xlsm?
Code:
Sub Save_With_Todays_Date()
'
' Save_With_Todays_Date Macro
' Save a copy of the workbook with todays date at the end.
ThisWorkbook.SaveCopyAs _
Filename:=ThisWorkbook.Path & "\" & _
ThisWorkbook.Name & _
Format(Date, "mm-dd-yy") & ".xlsm"
End Sub
You can use the Workbook.FullName property and parse off the extension.
Dim fpfn as String
fpfn = ThisWorkbook.FullName
ThisWorkbook.SaveCopyAs _
Filename:=Left(fpfn, InStrRev(fpfn, Chr(46)) - 1) & Format(Date, "mm-dd-yy"), _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
I would recommend leaving the extension off the Workbook.SaveAs method and let the XlFileFormat Enumeration assign the correct extension. Hardcoding the extension reduces functionality and can result in an incorrect extension being applied to a SaveAs.
ThisWorkbook.Name = Replace(ThisWorkbook.Name, ".xlsm", Format(Date, "mm-dd-yy") & ".xlsm")
Related
I created an Excel 2016-based template, which the user can fill and create a work form based on it. User inserts an unique ID and with basic INDEX&MATCH formulas some ID-related parameters are being fetched from separate worksheet a. The work form is created with VBA-macro using SaveCopyAs method.
After the parameters have been fetched and VBA is launched to create the work form the ID will not change anymore. Thus, I don't need the whole worksheet a anymore and would like to drop it to keep the work form more lightweight. I'm capable of retaining the fetched parameters, so this is not a problem.
I would NOT want the user to have to re-open the form every single time a work form is created, so I don't want the VBA to remove worksheet a from the template itself, as even though the user can't save changes to the template, (s)he would have to re-open the template file every time a work form has to be created.
Any idea if something could be done? Might it be possible to somehow run SaveCopyAs or similar method, but drop the worksheet a at the same time from the new target file? Having INDEX&MATCH formula fetch the needed information from another workbook would theoretically work but to my knowledge requires the other workbook to be open at all times which will undoubtedly start to cause unnecessary issues.
My current VBA for work form creating is something like this:
Sub Save_copy()
Dim FileName As String
With ActiveWorkbook
[H3] = Format(Now, "dd.mm.yy_hhmm")
Range("H2").Value = Range("H1").Value
FileName = "SERVICE " & _
Range("H1").Value & _
" - " & Format(Now, "dd.mm.yy") & _
"_" & Format(Now, "hhmm") & _
"." & Right(.Name, Len(.Name) - InStrRev(.Name, "."))
.SaveCopyAs "G:\SERVICE" & "\" & FileName
End With
Call Reset
End Sub
If I understood you properly try something like this ("air-coded" so there may be typos):
Sub Save_copy()
Dim FileName As String
With ActiveWorkbook
[H3] = Format(Now, "dd.mm.yy_hhmm")
Range("H2").Value = Range("H1").Value
FileName = "SERVICE " & _
Range("H1").Value & _
" - " & Format(Now, "dd.mm.yy") & _
"_" & Format(Now, "hhmm") & _
"." & Right(.Name, Len(.Name) - InStrRev(.Name, "."))
.SaveCopyAs "G:\SERVICE\" & FileName
End With
Dim newWorkbook As Excel.Workbook
Set newWorkbook = Workbooks.Open("G:\service\" & FileName)
newWorkbook.Worksheets("A").Delete
newWorkbook.Close True
Reset
End Sub
Additionally, a couple of coding tips:
There's no need for Call - that function is deprecated and only exists to keep ancient code from blowing up
There is an extra concatenation of the "\" in your .SaveCopyAs line - simply put the trailing slash in with the rest of the path (as I did).
The unqualified Range("H2") refers to the ActiveWorksheet and could blow up on you if your user ever happens to click on a different worksheet while your code is running
I am trying to build a macro that will save my Excel file with the specified name (customer and date).
Not working so far and as I am not very fluent in VBA maybe someone here would be willing to help:
Sub Save()
Sheets("Tool").Unprotect Password:="xxxx"
Dim fclient As String
Dim path As String
fclient = Range("G11").Value
path = Application.ActiveWorkbook.path
fname = "Discount for " & fclient
Application.ActiveWorkbook.SaveAs Filename:=path & "\" & fname & Format(Now, "DD-MM-YYYY"), FileFormat:=52, CreateBackup:=False
Sheets("Tool").Protect Password:="xxxx"
End Sub
Try using ThisWorkbook instead of Activeworkbook
Rather than putting the Format(Now(DD-MM-YYYY)) directly into your path, you can set the date into a cell in the sheet and then use the cells value as part of the file name the same as you have done for the clients name.
The Date function uses your current system date in the DD/MM/YYYY format rather than DD/MM/YYYY HH:MM:SS which Now uses.
I've adapted this to your code along with a 'find and replace' code to find the "/" in the date and replace it with "_". (NOTE this was simply recorded and could be written better I'm sure.) You could change the underscore to any other valid character for a file name if you wish.
In my test I removed Path as if you omit a path in the file name it will use the current files path.
Sub Save()
Dim fclient As String
Dim tdate As String
Range("G12") = Date
tdate = Range("G12")
fclient = Range("G11")
Cells(12, 7).Replace What:="/", Replacement:="_", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
tdate = Range("G12")
fname = "Discount for " & fclient
ThisWorkbook.SaveAs Filename:="\" & fname & "_" & tdate _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
I've assumed cell G12 is able to contain the date.
Why your original code doesn't work i'm not sure but this is an alternative.
Hi I wrote a code where it saves the excel sheet as PDF file into a our company's sharefolder (dropbox). I realized when my coworker tried to use that Macro, it doesn't work because of the path the file is saved.
in the code, where it says "MyComputerName" is what my computer name and i am guessing it's because my co workers computer name is different so it can't find the path on her computer.
Is there a way to solve this? so we both can use this macro and save it into the shared folder ?
Help!!!
Sub SaveAsPDF()
' FormatName
ActiveSheet.Name = "#" & ActiveSheet.Range("F6").Value & " " & ActiveSheet.Range("F4").Value
' saveAsPDF Macro
ActiveSheet.ExportAsFixedFormat Type:=xltypepdf, Filename:= _
"C:\Users\MyComputerName\Dropbox\Team Folder\PACKING LIST\201804\" & "PACKING LIST_" & ActiveSheet.Name _
, quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
End Sub
Try adding the following lines to the beginning of your code:
Dim username As String
username = Environ$("username")
And then your path should be:
"C:\Users\" & username & "\Dropbox\...
To make the year/month dynamic (assuming based on today's date), your link can be:
...LIST\" & Format(Now(), "yyyymm") & "\PACKING LIST...
At work, I've been trying to create a macro that will automatically clear a certain range - only content -, the range being B78:G83.
After clearing this range, I'd like the macro to save the current file under a new name. The new name should be the current day, with format "dd mmmm" (two digits for the name, a space in between and then the full month's name)
The file path is (f.e.)
"T:\RESERVATIONS\Duty Report\2017\4. April\25 april"
with the year, month and current date being variable (as we make separate folders for these files at work).
Sub NieuweDag()
'
' NieuweDag Macro
' Invoer wissen en opslaan als nieuwe dag
'
' Sneltoets: Ctrl+q
'
Range("B78:G83").Select
Range("G82").Activate
Selection.ClearContents
Dim FilePath As String
Dim NewName As String
FilePath = "T:\RESERVATIONS\Duty Report\": NewName = FilePath & Year(Now()) & "\" & Month(Now()) & ". " & MonthName(Now()) & "\" & Format(Date, "dd mmmm") & ".xlsm"
ActiveWorkbook.SaveAs Filename:=NewName, FileFormat _
:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
This is what I've got but it doesn't work. I get Error 5. It's in dutch, so allow me to translate:
Error 5 during launch:
Invalid procedure-call or invalid argument
Anyone out here be able to help me out?
The proper format is MonthName(number of month, [abbreviate]), you should use
MonthName(Month(Now()))
instead of
MonthName(Now())
Plus, you can enhance your code by using
Range("B78:G83").ClearContents
instead of
Range("B78:G83").Select
Range("G82").Activate
Selection.ClearContents
You can reduce the amount of coding required to create NewName by changing
NewName = FilePath & Year(Now()) & "\" & Month(Now()) & ". " & MonthName(Now()) & "\" & Format(Date, "dd mmmm") & ".xlsm"
to
NewName = FilePath & Format(Now(), "yyyy\\m. mmmm\\dd mmmm") & ".xlsm"
I would like to make my macro able to save a xlsx file as csv exactly with the same name when running it.
This is what I tried:
ActiveWorkbook.saveas Filename:=ActiveWorkbook.Path & "\" & _
ActiveWorkbook.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False
However, it saves the file as .xlsx.csv (i.e, a file called prices.xlsx is saves as prices.xlsx.csv)
How could I save the file with a different file extension, without the .xlsx?
Filename := ActiveWorkbook.Path & "\" & Replace(ActiveWorkbook.Name,".xlsx", ".csv")
If you want to make it more failsafe, in case your extension may be xls, xlsm, xlsb, you can do something like this:
Dim parts As Variant
parts = Split(ActiveWorkbook.Name, ".")
parts(UBound(parts)) = "csv"
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & _
Join(parts, "."), FileFormat:=xlCSV, CreateBackup:=False
It's probably not 100% bulletproof, although I'm struggling to think of a situation where it would not work as expected.