Auto generated excel file name VBA Macro?
Hi all i want auto generated excel file name in macro
my code is below here
Sub Sheet_SaveAs()
Dim wb As Workbook
Sheets("Sheet1").Copy
Set wb = ActiveWorkbook
With wb
.SaveAs ThisWorkbook.Path & "\autogenrate.xlsx"
'.Close False
End With
End Sub
my code is working fine but when i save next time then asking do you want replace it but i want auto generate name
The simplest fix is to change to a unique name each time. The easiest way to do this might be to use a date-time string
Sub Sheet_SaveAs()
Dim wb As Workbook
Sheets("Sheet1").Copy
Set wb = ActiveWorkbook
With wb
.SaveAs ThisWorkbook.Path & "\" & _
Format(Now, "yyyymmdd") & _
Replace(Format(Now, "Long Time"), ":", "") & _
".xlsx"
.Close False
End With
End Sub
The date and tie part are seperate to allow you to use seconds and therefore your limit is 1 save per second. If you need more frequent saves you would have to include a millisecond counter too. The good thing about this method is that it keeps your backups in sequential order in the folder.
You can read more about formatting dates etc. here - https://msdn.microsoft.com/en-us/library/office/gg251755.aspx
Related
I have following code:
Sub MacroRunner()
Dim Nomefile As String, Nomefolder As String
Nomefolder = ActiveWorkbook.Path
Nomefile = Dir(Nomefolder & "\*.xlsb")
Workbooks.Open (Nomefolder & "\" & Nomefile)
ActiveWorkbook.Worksheets(2).Select
Application.Run "Nomefile!listaIdprodotto" '<-------- "nomefile" variable not returned
Application.DisplayAlerts = False
ActiveWindow.Close
End Sub
The issue is in line marked by a left arrow; Excel doesn't return variable value making itself unable to find asked Macro to be executed.
Thanks for any help.
You should refer a bit differently (in case that Nomefile.xlsb is the file):
Application.Run "'Nomefile.xlsb'!listaIdprodotto"
Or even (in case that Nomefile is a variable):
Application.Run "'" & Nomefile & "'!listaIdprodotto"
Source
It would be better to be more specific about what files and sheets you want to act on.
Nomefolder = ActiveWorkbook.Path
This isn't necessarily the workbook containing the code. If you create a new workbook immediately before running the code then this will equal an empty string - it's whichever workbook is currently on top (active).
Nomefile = Dir(Nomefolder & "\*.xlsb")
This will return the first file in the folder that has an xlsb extension. If todays file wasn't created it will return the previous file and run yesterdays update again.
If it's a file that's generated each day then look for the file name with the correct date.
ActiveWorkbook.Worksheets(2).Select
Again - same problem with ActiveWorkbook. This is also looking at the second sheet in the tab order which may not be the sheet you're after if someone moved it. Reference the sheet by name (which could still be changed). It would be better to reference by sheet CodeName which can't be changed by the user, but that opens a different kettle of worms as the sheet you're referencing isn't in the workbook containing the code.
Application.Run "Nomefile!listaIdprodotto"
As you've enclosed Nomefile within the double quotes it's not seeing it as a variable but as a file called Nomefile. To see it as a variable it needs to be written as Application.Run Nomefile & "!listaIdprodotto". If the file name contains spaces then it needs to be written as Vityata has written: Application.Run "'" & Nomefile & "'!listaIdprodotto". This encloses the file name in single quotes.
I'd rewrite the code as:
Public Sub Test()
Dim Nomefile As String, Nomefolder As String
Dim wrkBk As Workbook
'Nomefolder = ActiveWorkbook.Path
Nomefolder = ThisWorkbook.Path
'Nomefile = Dir(Nomefolder & "\*.xlsb")
Nomefile = Nomefolder & "\WorkbookWithCode.xlsb"
'Open the workbook, run the code and close the workbook.
Set wrkBk = Workbooks.Open(Nomefile)
Application.Run "'" & wrkBk.Name & "'!listaIdprodotto"
wrkBk.Close
End Sub
The main difference here is that I set the whole workbook to a variable - Set wrkBk = ..... From there on I can always reference the correct workbook and don't have to worry whether it's Active or not.
I have a workbook that I format through macros I recorded. The macros currently rename the file and save it to a constant path, but I need it to rename the file and save it to a relative path so that other teammates can use it. Are there any suggestions?
This is the active file
Windows("Manual Reconciliation Template.xlsm").Activate
This is the constant path
ActiveWorkbook.SaveAs FileName:= _
"C:\Users\e6y550m\Documents\MANUAL RECS\Manual Reconciliation Template.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Current code:
Sub Name_And_Save_Report()
'
' TO NAME, DATE AND SAVE THE REPORT AFTER IT HAS BEEN WORKED.
'
Windows("Manual Reconciliation Template.xlsm").Activate
Dim thisWb As Workbook
Dim fname
fname = InputBox("Enter your name (example-John):")
Set thisWb = ActiveWorkbook
Workbooks.Add
ActiveWorkbook.SaveAs FileName:=thisWb.Path & "\" & fname & "_Manual Recon" & " " & Format(Date, "MM.DD.YY") & ".xlsx"
ActiveWorkbook.Close savechanges:=False
Windows("Manual Reconciliation Template.xlsm").Activate
ActiveWorkbook.Close savechanges:=False
End Sub
So, you'll paste a copy of the workbook containing the above code in each persons folder. When they open the workbook you want it to rename itself as:
<< person name >>_Manual Recon << mm.dd.yy >>.xlsx
I assume you want the original file left in there so they can open it and create a new xlsx for the following day, but not create a file if it already exists (in case they open the xlsm twice in one day).
Another point to consider - is their personal folder given their name?
E.g. G:\MMS Trade Payables\John
I noticed in your code you set a variable thisWb to equal the ActiveWorkbook.
You could just use ThisWorkbook which always refers to the workbook that the code is running in.
So with these assumptions, try this code:
Sub Name_And_Save_Report()
Dim fName As String
Dim sNewFile As String
'Get the folder name.
fName = GetParentFolder(ThisWorkbook.Path)
'Could also get the Windows user name.
'fName = Environ("username")
'Or could get the Excel user name.
'fname = application.username
'Or could just ask them.
'fname = InputBox("Enter your name (example-John):")
sNewFile = ThisWorkbook.Path & Application.PathSeparator & _
fName & "_Manual Recon " & Format(Date, "mm.dd.yy") & ".xlsx"
If Not FileExists(sNewFile) Then
'Turn off alerts otherwise you'll get
'"The following features cannot be saved in macro-free workbooks...."
'51 in the SaveAs means save in XLSX format.
Application.DisplayAlerts = False
ThisWorkbook.SaveAs sNewFile, 51
Application.DisplayAlerts = True
End If
End Sub
Public Function FileExists(ByVal FileName As String) As Boolean
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
FileExists = oFSO.FileExists(FileName)
Set oFSO = Nothing
End Function
Public Function GetParentFolder(ByVal FilePath As String) As String
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
GetParentFolder = oFSO.GetFolder(FilePath).Name
Set oFSO = Nothing
End Function
I'll leave this here as my first answer:
Do you mean something like this?
Using the FileSystemObject to recursively get the parent folder name.
Sub Test()
MsgBox ThisWorkbook.Path & vbCr & RelativePath(ThisWorkbook.Path, 2)
'Will return "C:\Users\e6y550m" - step back 2 folders.
MsgBox RelativePath("C:\Users\e6y550m\Documents\MANUAL RECS\", 2)
'Your line of code:
'ActiveWorkbook.SaveAs FileName:=RelativePath(thisWb.Path, 2) & "\" & fname & "_Manual Recon" & " " & Format(Date, "MM.DD.YY") & ".xlsx"
End Sub
'FilePath - path to file, not including file name.
'GetParent - the number of folders in the path to go back to.
Public Function RelativePath(FilePath As String, Optional GetParent As Long) As String
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
'If rightmost character is "\" then we've reached the root: C:\
If GetParent = 0 Or Right(FilePath, 1) = Application.PathSeparator Then
RelativePath = oFSO.GetFolder(FilePath)
'If we've reached the root then remove the "\".
If Right(RelativePath, 1) = Application.PathSeparator Then
RelativePath = Left(RelativePath, Len(RelativePath) - 1)
End If
Else
'GetParent is greater than 0 so call the RelativePath function again with
'GetParent decreased by 1.
RelativePath = RelativePath(oFSO.GetParentFolderName(FilePath), GetParent - 1)
End If
Set oFSO = Nothing
End Function
I apologize if my question wasn't clear; I am a VBA novice at best.
'This is the current file that is already open,
Windows("Manual Reconciliation Template.xlsm").Activate
' I want to share this file with my teammates so they can use it. They all have different folders. I will place a copy of this workbook in each of their folders. When they use the copy that is in their personal folder, the macro needs to rename the workbook and save the renamed copy in their personal folder. The macro therefore needs code that will rename the workbook and save it in their folder without having a defined path. The shared drive path is G:\MMS Trade Payables. Within the MMS Trade Payables folder are the personal folders. I think the code just needs to activate the current workbook that is already open, rename it and save it in the current folder as an .xlsx instead of an .xlsm.
Current code:
Sub Name_And_Save_Report()
'
' TO NAME, DATE AND SAVE THE REPORT AFTER IT HAS BEEN WORKED.
'
Windows("Manual Reconciliation Template.xlsm").Activate
Dim thisWb As Workbook
Dim fname
' Will use the fname variable to add the associates name to the file name (ex:If the associate enters Mark into the inputbox, fname will = Mark).
fname = InputBox("Enter your name (example-John):")
' Makes thisWb = "Manual Reconciliation Template.xlsm".
Set thisWb = ActiveWorkbook
Workbooks.Add
' Saves the active workbook ("Manual Reconciliation Template.xlsm") to the path of thisWb and renames the workbook by adding the fname value and the current date (ex: if the associate entered Mark as the value of fname, "Manual Reconciliation Template.xlsm" becomes "Mark_Manual Recon 7.14.17.xlsx").
ActiveWorkbook.SaveAs FileName:=thisWb.Path & "\" & fname & "_Manual Recon" & " " & Format(Date, "MM.DD.YY") & ".xlsx"
' Closes the renamed workbook.
ActiveWorkbook.Close savechanges:=False
' Calls the original workbook and closes it.
Windows("Manual Reconciliation Template.xlsm").Activate
ActiveWorkbook.Close savechanges:=False
End Sub
Of course, this could be completely wrong since I am new to VBA.
Does there exist a code to for example save every hour the data from A1:B10 in sheet1 to a CSV file ?
Although this can be done in many different ways, this is what I'd do:
1) Add the following sub to a new file. Let's call it "auto.xlsb"
Sub SaveRangeToCSV()
Dim rng As Range
Dim originWB As Workbook
Dim originWS As Worksheet
Dim newBook As Workbook
Dim newBookWS As Worksheet
'Open the file you want to copy the range from
Set originWB = Workbooks.Open("path_to_file_that_contains_the_range_you_want_to_copy.xlsx")
Set originWS = ThisWorkbook.Sheets("name_of_the_sheet_where_the_range_is")
Set rng = originWS.Range("A1:B10")
'Add new workbook (csv file)
Workbooks.Add
Set newBook = ActiveWorkbook
Set newBookWS = newBook.Sheets(1)
'Copy range from origin to destination (csv file)
rng.Copy Destination:=newBookWS.Range("A1")
'Save csv file
newBook.SaveAs Filename:=ThisWorkbook.Path & "\output.csv"
End Sub
If you want to avoid the output.csv to be overwritten every 10 minutes, you could, for example, add current datetime to the filename like this:
'Save csv file
newBook.SaveAs Filename:=ThisWorkbook.Path & "\output_" & Replace(Replace(Replace(Now, "/", ""), ":", ""), " ", "") & ".csv"
2) Add this code to Workbook_Open Sub (click ThisWorkbook sheet in VBA IDE, and select Workbook and Open from the dropdown) in auto.xlsb, and Save:
Private Sub Workbook_Open()
Call Module1.SaveRangeToCSV
End Sub
Every time you doble-click to open the file, SaveRangeToCSV will be triggered and, hence, the csv created.
3) Automating the execution of this file really depends on your preferences and the Operating System you are working on. I'm assuming your are on Windows, so the easiest way to do it would be creating a task in Windows' Task Scheduler which runs "auto.xlsb" every 10 minutes.
I hope this helps.
From a Personal.xlsb file, I want VBA to save the current active workbook as a user-definable name in the same directory and delete the original workbook.
Below is my code. It has two problems. One, it saves the workbook in My Documents folder for some reason. The active workbook is not in My Documents. It's in a folder in a completely different drive. Two, it throws a "File not found" error.
Sub RenameFile()
Dim thisWb As Workbook
Set thisWb = ActiveWorkbook
MyOldName = ActiveWorkbook.Name
MyNewName = InputBox("What do you want to rename the file as?", "Rename", ActiveWorkbook.Name)
ActiveWorkbook.SaveAs Filename:=thisWb.Path & MyNewName
Kill MyOldName
End Sub
You need to include a \ after path and before filename.
Sub RenameFile()
Dim thisWb As Workbook
Set thisWb = ActiveWorkbook
MyOldName = ActiveWorkbook.FullName
MyNewName = InputBox("What do you want to rename the file as?", "Rename", ActiveWorkbook.Name)
ActiveWorkbook.SaveAs Filename:=thisWb.Path & "\" & MyNewName
Kill MyOldName
End Sub
Edit: Updated answer to include fix from comment.
So I have some code that I use to auto save files (to a directory specified in the code) and then deletes a particular file type out of said folder. (I use it to save a .xlsx and delete .csv)
'Saves file to specified location
ActiveWorkbook.SaveAs filename:="C:\Desktop\Testing\Testing File " _
& Format(Now() - 1, "DD.MM.YY") & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
On Error Resume Next
Kill "C:\Desktop\Testing*.csv*"
On Error GoTo 0
This is the code that I used that is within a longer VBA module, but you could incorporate this into existing VBA code
Take note that that currently saves the file as Testing with the day before the current system date in the name, such as "Testing 30.10.16"
I am using a workbook that generates reports according to the country selected. Each country uses an specific path directory.
When it comes to import information form their root folder its OK.
My problem is when I generate a new workbook with the report. I try to save it in the specific location which changes with the country:
'Generate a new workbook refering to the first Worksheet
Set WkReport = Workbooks.Add(xlWBATWorksheet)
With WkReport
// Skip selecting the sheet, just reference it explicitly and copy it after//
// the blank sheet in the new wb.
ThisWorkbook.Worksheets("REPORT").Copy after:=.Worksheets(.Worksheets.Count)
End With
// Kill alerts, delete the blank sheet in the new wb and turn alerts back on//
Application.DisplayAlerts = False
With WkReport
.SaveAs Filename:="L:\Fold1\Fold2\Fold3\" & rngFolder & "\" & rngYear & "\" & rngMonth &"\"& rngName & "_Report_" & rngDate & ".xlsx"
End With
Application.DisplayAlerts = True'`enter code here`
L:\Fold1\Fold2\Fold3: fixed path
rngFolder is the Path for the Country
rngYear is the Path for a subfolder within Country
rngMonth is the Path for a subfolder within the Year
(rngSmthing are ranges referring to cells in the workbook)
All those are dynamics ranges that changes according to information introduced by the user.
Therefore when I create the workbook it must be saved in different location according to this information.
Name of the file contains another dynamic range "rngName" followed up by Report and "rngDate":
Filename = rngName_Report_rngDate.xlsx
What my code does is to save in L:\Fold1\Fold2\Fold3 with the filename Report.xlsx
Examples of Path directories if user selects...
Germany:
L:Folder1\Folder2\Folder3\Germany\2015\06-2015\GE_Report_31-06-15.xlsx
Hungary:
L:Folder1\Folder2\Folder3\Hungary\2015\06_2015\HU_Report_31-06-15.xlsx
!PROBLEM SOLVED! I simply forgot to set the rngSmthng Variables... (Clap Clap) Anyway, someone may find it useful in case that you want to set different save paths according to your ranges:
'cellRef is a named cell within the workbook where user selects data
rngName = ws.Range("cellRef").Value
In that way you have a dynamic path finder.
Glad you found the answer. As a side-note - this is how I would write the procedure.
Sub Test()
Dim wkReport As Workbook
Dim sFolder As String
Dim sPath As String
Dim rngFolder As Range
Dim rngName As Range
With ThisWorkbook.Worksheets("Sheet1")
Set rngFolder = .Range("A1")
Set rngName = .Range("A2")
End With
sFolder = "L:\Fold1\Fold2\Fold3\" & rngFolder & "\" & Format(Date, "yyyy\\mm mmm\\")
CreateFolder sFolder
sPath = sFolder & rngName & "_Report_" & Format(Date, "dd-mm-yy") & ".xlsx"
Set wkReport = Workbooks.Add(xlWBATWorksheet)
With wkReport
ThisWorkbook.Worksheets("REPORT").Copy after:=.Worksheets(.Worksheets.Count)
.Worksheets(1).Delete
.SaveAs sPath, ThisWorkbook.FileFormat
End With
End Sub
' Purpose : Will Recursively Build A Directory Tree
Sub CreateFolder(Folder)
On Error Resume Next
Dim objFSO As Object: Set objFSO = CreateObject("Scripting.FileSystemObject")
If Folder <> "" Then
If Not objFSO.FileExists(objFSO.GetParentFolderName(Folder)) Then
Call CreateFolder(objFSO.GetParentFolderName(Folder))
End If
objFSO.CreateFolder (Folder)
End If
End Sub
Note:
Format(Date, "yyyy\\mm mmm\\") will return 2015\12 Dec\.
Format(Date, "yyyy\mm mmm\") will return 2015m12 Dec.
Really sorry guys...
And many thanks for your help... no way you could have guessed it.
The problem was that those variables I have them set in a different macro, which I completely forgot... so of course it does not recognize the variables.. because I didnt create them in this Macro!!
Again my apologies should review my code twice before posting