Appending Username and Date to Save As in VBA - 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

Related

Showing excel save as dialog box and prefill with cell reference

With no coding knowledge, I have attempted to use some code found here: Automatically name a file based on cell data when saving a spreadsheet?. Thanks to Jean-François Corbett
I have adapted as follows to show the dialog box:
Sub SaveAsString()
Dim strPath As String
Dim strFolderPath As String
strFolderPath = "N:\PROJECTS\"
strPath = strFolderPath & _
Sheet1.Range("B2").Value & "_" & _
Sheet1.Range("B6").Value & "_" & _
Sheet1.Range("X1").Value & "-JS-1" & ".xlsm"
Application.Dialogs(xlDialogSaveAs).Show strPath
ActiveWorkbook.SaveAs FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub
I am opening an .xltm file, and attempting to save with the ability to select the subfolder of N:\PROJECTS\ with the combination of cell references shown.
The dialog box appears fine, already showing N:\PROJECTS. However, it does not fill the file name, unless the file is first saved as a .xlsm. It then always attempts to overwrite as well.
This worked for me, utilizing a slightly different code technique.
Option Explicit
Sub SaveAsString()
Dim strPath As String
Dim strFolderPath As String
ChDir "N:\PROJECTS\" 'set directory with this line
With Sheet1
strPath = .Range("B2").Value
strPath = strPath & "_" & .Range("B6").Value
strPath = strPath & "_" & .Range("X1").Value
strPath = strPath & "-JS-1.xlsm"
End With
Application.Dialogs(xlDialogSaveAs).Show strPath 'load file name with this argument
ActiveWorkbook.SaveAs FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub
The main issue remaining was that opening from a template didn't automatically save as .xlsm. Apparently Application.Dialogs doesn't support file filters, so the problem is better solved with GetSaveasFileName.
Full code as follows:
Sub SaveAsString()
Dim strPath As String
Dim strFolderPath As String
strFolderPath = "N:\PROJECTS\"
strPath = strFolderPath & _
Sheet1.Range("B2").Value & "_" & _
Sheet1.Range("B6").Value & "_" & _
Sheet1.Range("X1").Value & "-JS-1" & ".xlsm"
fileSaveName = Application.GetSaveAsFilename(strPath _
, fileFilter:="Excel Files (*.xlsm), *.xlsm")
End Sub

Creating a macro that resets file and saves as new day

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"

Save as date and time not working

It is supposed to save as file name: Folder\test location 'what ever is in cell C27' and then data and time. I am getting :'008 11 2015 00 00 00'. How do I clean this up with out using "/" and ":"? Note the first 0 is just the test number I used.
Also this macro is in a template that the Testing software uses that is why it has to use Auto_open but the other problem is that when it saves as a non template file, upon opening it tries to run the macro in the non template file. How can I make it so the macro does not save in or is disabled in the save as files/ non template files?
Sub Auto_Open()
Dim FileName As String
Dim FilePath As String
Dim FileDate As String
MyNote = "Is Cell 'C27' Overview Information" & SavePath & " Location_1,2,3,or 4?"
Answer = MsgBox(MyNote, vbQuestion + vbYesNo)
If Answer = vbYes Then
FilePath = "C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test"
FileName = Sheets("Data").Range("C27").Text
ThisWorkbook.SaveAs FileName:=FilePath & "\" & FileName
Dim FileCopyName As String
Dim FileCopyPath As String
FilePath = "C:\Users\aholiday\Desktop\Backup"
FileName = Sheets("Data").Range("C27").Text
FileDate = Format(Date, "mm dd yyyy hh mm ss")
ThisWorkbook.SaveAs FileName:=FilePath & "\" & FileName & FileDate
MsgBox "File was saved!"
MyNote = "Open FRF Data Sheet?(After Forth Test Only)"
Answer = MsgBox(MyNote, vbQuestion + vbYesNo)
If Answer = vbYes Then
Workbooks.Open ("FRF_Data_Sheet_Template.xlsm")
Else
MsgBox "Ready for Next Test, Please Exit."
End If
Else
MsgBox "File was not saved, Please Use Location_1,2,3or,4 Durring SIG ATM Test"
End If
End Sub
Solved:
Sub Auto_Open()
With Range("A30")
.Value = Time
.NumberFormat = "h-mm-ss AM/PM"
End With
Dim FileName As String
Dim FilePath As String
Dim FileDate As String
MyNote = "Is Cell 'B27' Overview Information" & SavePath & " Location1,2,3,or 4?"
Answer = MsgBox(MyNote, vbQuestion + vbYesNo)
If Answer = vbYes Then
FilePath = "C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test"
FileName = Sheets("Data").Range("C27").Text
ThisWorkbook.SaveAs FileName:=FilePath & "\" & FileName
Dim FileCopyName As String
Dim FileCopyPath As String
Dim FileTime As String
FilePath = "C:\Users\aholiday\Desktop\Backup"
FileName = Sheets("Data").Range("B27").Text
FileTime = Sheets("Data").Range("A30").Text
ThisWorkbook.SaveAs FileName:=FilePath & "\" & FileName & FileTime & ".xlsx", FileFormat:=xlOpenXMLWorkbook
MsgBox "File was saved!"
MsgBox "Ready for Next Test, Please Exit."
Else
MsgBox "File was not saved, Please Use Location_1,2,3or,4 Durring SIG ATM Test"
End If
End Sub
You can't have a \ in a filename.
For the date part, use the format function. You can define the date format if you want by using "MM-dd-yyy"
ThisWorkbook.SaveAs FileName:=FilePath & "\" & FileName & Format(FileDate, "MM-dd-yyyy") & ".xlsx", FileFormat:=xlOpenXMLWorkbook
Use the FileFormat:=xlOpenXMLWorkbook to save it as a workbook without macros.

Excel 2010 VBA: Save file using value from cell to determine path and filename

I am trying to write some code that will save several tabs as a pdf document in folder specified by files within excell. I would like for cells within the document to dictate where this file is saved. I am not sure if this is possibly, but if it is any help would be good! I am currently getting a Run-time error '1004' during the save process of my code.
And yes, I do have the folders created that are being referenced.
Sub asdf()
Dim Fname As String
Dim Fpath As String
Dim YrMth As String
Fname = Sheets("Sheet1").Range("A1").Text
YrMth = Sheets("Sheet1").Range("A2").Text & "\" & Sheets("Sheet1").Range("A3").Text
Fpath = "C:\Documents and Settings\My Documents\" & YrMth & "\Group\" & Fname & ".pdf"
ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet4")).Select
Application.DisplayAlerts = False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Fpath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub
Your code works for me, but not with the path you've specified.
Declare a new string variable:
dim myDocsPath as String
Get the path using:
myDocsPath = Environ$("USERPROFILE") & "\My Documents\"
and then change your definition for Fpath to:
Fpath = myDocsPath & YrMth & "\Group\" & Fname & ".pdf"
If I change the end of myDocsPath to & "\My foo Documents\" I get the same 1004 error you are getting.
Try replace line in your code
Fpath = "C:\Documents and Settings\My Documents\" & YrMth & "\Group\" & Fname & ".pdf"
with
Dim WshShell As Object
Dim MyDocsFolder As String
Set WshShell = CreateObject("WScript.Shell")
MyDocsFolder = WshShell.SpecialFolders("MyDocuments") & "\"
Fpath = MyDocsFolder & YrMth & "\Group\" & Fname & ".pdf"
Edit:
The core of this solution is in line:
MyDocsFolder = WshShell.SpecialFolders("MyDocuments") & "\"
which returns system path to My Documents, irrespectively from local system settings like language or nonstandard location of My Documents folders. Then it adds a backslash at the end.
It is more elegant (and the code becomes more portable) if you ask system about special folders than hardcode such data in your script.
More on Windows special folders in VBA you can find https://www.rondebruin.nl/win/s3/win027.htm

Macro with Save Current date

Is there a way to make a macro to save a file with the current day in the name. I want to save this off everyday with the correct date.
This is what I have as a macro, pretty simple, but I am having issues with getting the current date formula in the file name (if possible)
Sub Save()
ActiveWorkbook.SaveAs Filename:="X:\file06-21-2012\.xlsm", FileFormat _
:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
So tomorrow i would want the marco to save it as file06-22-2012.
Thanks
Like this?
Sub Save()
Dim FilePath As String
Dim NewName As String
FilePath = "X:\": NewName = FilePath & "file" & Format(Date, "MM-DD-YYYY") & ".xlsm"
ActiveWorkbook.SaveAs Filename:=NewName, FileFormat _
:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
WIth all due respect to #HeadofCatering's answer, a simpler, more easily readable approach would be this, I think.
Sub Save()
Dim dtDate As Date
dtDate = Date
Dim strFile As String
strFile = "X:\file" & Format(dtDate, "mm-dd-yyyy") & ".xlsm"
ActiveWorkbook.SaveAs Filename:=strFile, FileFormat _
:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub