Creating a macro that resets file and saves as new day - vba

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"

Related

Is there a way to Get Last Directory so I can Save As into?

I am able to create a new directory on my desktop, my issues is that I don't know how to save multiple files into that folder, within the same Sub, since it has a dynamic name.
Option Explicit
Sub Make_Folder_On_Desktop()
Dim selectionsheet As Worksheet
Dim Group As Variant
Dim amount As Long
Dim BU As Long
Dim BUname As Variant
Dim sFilename As Variant
Set selectionsheet = Sheets("Project Selection")
Group = selectionsheet.Range("A19").Value
amount = selectionsheet.Range("B19").Value
BU = selectionsheet.Range("B6").Value
BUname = selectionsheet.Range("C6").Value
sFilename = BU & " - " & BUname
MkDir Group & " - " & amount & " - " & Format(Date, "mm-dd-yyyy") & " - "
& Format(Time, "hhmmss")
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sFilename
End Sub
Last line is where I'm having the issue. I have "ThisWorkbook.Path" but can't figure out how to get it into the new folder I just created.
MkDir Group & " - " & amount & " - " & Format(Date, "mm-dd-yyyy") & " - " & Format(Time, "hhmmss")
It's hard to know what the folder name is that you just created, because that instruction is responsible for too many things. Split it up.
Build/concatenate a folder name
Make a directory by that name
If we split up the work, things get much simpler:
Dim path As String
path = Group & " - " & amount & " - " & Format(Date, "mm-dd-yyyy") & " - " & Format(Time, "hhmmss")
MkDir path
And now we have the path in the ...path variable, readily usable for anything you might want to do with it:
ActiveWorkbook.SaveAs path & "\" & sFilename
As a side note, if you make the date format yyyy-mm-dd instead, you're ISO-compliant (i.e. the date is unambiguous everywhere in the world), and the folders become sortable by name.
Note that the procedure's name is misleading: it doesn't care where the folder is, and there's nothing that says it's under %USERPROFILE%\Desktop. Use Environ$("USERPROFILE") to retrieve the base path for the current user's profile directory.

File is not saving to newly made folder in VBA

I have a macro that created a folder by data within a pathway, and I want a cut of a manager roster to be saved in that folder. Since the folder name varies, this needs to be dynamic.
I want it to go something like this:
Dim sPath As String
sPath = "M:\mgr1_TCR_Reports\"
If Len(Dir(sPath & "_" & Format(Date, "mm_dd_yyyy"), vbDirectory)) = 0 Then
MkDir (sPath & "_" & Format(Date, "mm_dd_yyyy"))
End If
End Sub
and saving this like:
.SaveAs Filename:="M:\mgr1_TCR_Reports\" & "_" & Format(Date, "mm_dd_yyyy_") & "\" & Manager, FileFormat:=xlOpenXMLWorkbook, Password:=""
.Close
But I keep getting a runtime 1004: document not saved on ^^^ the second line of code I provided.
Any idea what's going on?

VBA:adding files with new version _vX, with separate dates

I am having trouble with creating new version, with the dates selected by the users.
So here I have 2 separate workbooks:
1) Macro - where the users will click the button and generate the macro
2) Report template - when the users click the macro, the figures will be generated into the templates, with the dates in the naming convention, and the version.
The report template naming convention looks like this : BSLCT_DDMMYYYYG where DDMMYYYY is the date, that the users will select in the report template.
So when the report is generated, it will SaveAs another file i.e BSLCT_10072020G.
The code I used to generate is as follow:
Sub Naming reports()
Windows("BSTCT_DDMMYYYYG.xls").Activate
Sheets("G.0(GenInfo)").Select
ActiveWorkbook.SaveAs Path & "\BSLCT_" & REPORT_DATE & "G.xls"
ActiveWorkbook.Close
End Sub
where i define the REPORT_DATE before that.
Now, the users need to have a versioning in their file naming as well, which is something like BSTCT_DDMMYYYYG_vX.xls. So as long as the users run the macro, the macro will generate a new version, regardless of whether the date has already existed.
I managed to create a _v1 using the following codes:
Sub version
Windows("BSTCT_DDMMYYYYG.xls").Activate
Sheets("G.0(GenInfo)").Select
If InStr(ActiveWorkbook.Name, "_v") = 0 Then
fileName = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name,
InStr(ActiveWorkbook.Name, ".") - 1) & "_v1." & ext
ActiveWorkbook.SaveAs (fileName)
Else
index = CInt(Split(Right(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - InStr(ActiveWorkbook.Name, "_v") - 1), ".")(0))
index = index + 1
fileName = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name,InStr(ActiveWorkbook.Name, "_v") - 1) & "_v" & index & "." & ext
End If
ActiveWorkbook.SaveAs (fileName)
End Sub
However, after generating the v1, I couldn't generate v1 onwards, because i need to activate the "BSTCT_DDMMYYYYG.xls" window to pick up the report date, this will then break my codes.
Also, while I am adding the version, at the same time i would like to get the DDMMYYYY into the naming too.
How can I do that?
I really appreciate your helps.
now i am trying to keep adding the newer version with the following code:
Sub SaveNewVersion()
Dim fileName As String, index As Long, ext As String, sVersion As String
arr = Split(ActiveWorkbook.Name, ".")
ext = arr(UBound(arr))
sVersion = "_v"
Windows("BSLCT_DDMMYYYYG.xls").Activate
Sheets("G.0(GenInfo)").Select
If InStr(ActiveWorkbook.Name, "_v") = 0 Then
fileName = ActiveWorkbook.Path & "" & Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".") - 1) & "_v1." & ext
ActiveWorkbook.SaveAs "\BSLCT_" & REPORT_DATE & "G" & sVersion & index & ".xls"
Else
index = CInt(Split(Right(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - InStr(ActiveWorkbook.Name, "_v") - 1), ".")(0))
index = index + 1
fileName = ActiveWorkbook.Path & "" & Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, "_v") - 1) & "_v" & index & "." & ext
ActiveWorkbook.SaveAs "\BSLCT_" & REPORT_DATE & "G " & sVersion & index & ".xls"
End If
ActiveWorkbook.Close
End Sub
but at first it keeps replacing my first version, and then saying that this line of code:
index = CInt(Split(Right(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - InStr(ActiveWorkbook.Name, "_v") - 1), ".")(0)) has syntax error.
Does anyone can help on this? I am really clueless where can I modify this.
Try this:
Sub SetNewName()
Dim wbk As Workbook
Dim sDate As String
Dim sVersion As String
sDate = Format(Date, "ddMMyyyy")
sVersion = "_v1"
Set wbk = Application.Workbooks("BSTCT_DDMMYYYYG.xls")
wbk.SaveAs ActiveWorkbook.Path & "\" & sDate & sVersion & ".xls"
End Sub

Excel/VBA Remove text from ThieWorkbook.Name

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")

Appending Username and Date to Save As in VBA

How can I save the excel file using vba code so that the Username and Date are attached in a macro?
Here is the code that I worked on to try to make it work:
ActiveWorkbook.SaveAs FileName:=(Environ$("Username")) & "_" & Date & "_BKMtracker.xlsx", FileFormat:=xlOpenXMLWorkbook
Try this:-
ActiveWorkbook.SaveAs FileName:=(Environ$("Username")) & "_" & Date & "_BKMtracker.xlsx", FileFormat:=xlOpenXMLWorkbook
With credit to #MatthewD
Sub SaveDocument()
Dim username As String
Dim nowFormated As String
Dim path As String
Dim filename As String
Dim extention As String
username = Environ("Username") & "_" 'gets the username
nowFormated = CStr(Format(now, "yymmdd")) 'or every format you like
path = "D:\" 'Wherever you want to save the file
filename = "_BKMtracker" 'or what you want
extention = ".xlsm" 'for example (with macros, else you have to change the FileFormat too)
ActiveWorkbook.SaveAs filename:=path & username & nowFormated & filname & extention, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub