I want to leave the latest 7 backups and delete the rest ...
& I want to keep the first backup of each Month ...
& The programm should OpenAsReadOnly the backups without asking!
Here is my code:
Option Explicit
Sub Workbook_Open()
If Dir(ActiveWorkbook.Path & "\" & "Backup", vbDirectory) = "" Then
MkDir (ActiveWorkbook.Path & "\" & "Backup")
End If
Dim Pfad As String
Dim Datumzeitstempel As String
Dim Jetzt As Date
Jetzt = Now()
Pfad = ActiveWorkbook.Path & "\" & "Backup"
Datumzeitstempel = Year(Date) & Format(Month(Date), "00") & Format(Day(Date), "00")
ActiveWorkbook.SaveCopyAs (Pfad & "\" & Datumzeitstempel & ".xlsm")
ReadOnlyRecommended = True
End Sub
To solve problem with backup rotation you can do following. Instead of writing files with month and day in it, use WEEKDAY function. Then you will overwrite daily backup every time you open your file leaving backups for last week / 7 days.
To solve monthly backup problem You can do same just by using month only. When new month comes the new backup will be started.
Only problem with this solution is that last backup will be overwritten every time you open your file.
If you really need first backup made, then you will have to check for file existence.
But maybe better solution will be to write a script external to your file and run backup on scheduled basis E.g. at midnight. It can even be vbscript you are familiar with.
Related
I am trying to write some VBA to update a report with the most current data daily from a table. This report collects all the data from this table and shows it in a presentable manner but I don't want it to grab previous days data, only update from 12:00am to 12:00pm for instance every day, then incorporate this with my code to export this report as a pdf (which already works, but just shows the whole table constantly). It should be possible as my report has dates that are stored as values, I just don't know how to go about it with If statements etc. Here is my code for a module that is connected to a macro that is automatically run daily.
Function Reportmacro()
On Error GoTo Reportmacro_Err
Dim fpath As String
' Check for year folder and create if needed
If Len(Dir("H:\TEST\" & Year(Date), vbDirectory)) = 0 Then
MkDir "H:\TEST\" & Year(Date)
End If
' Check for month folder and create if needed
If Len(Dir("H:\TEST\" & Year(Date) & "\" & MonthName(Month(Date), False), vbDirectory)) = 0 Then
MkDir "H:\TEST\" & Year(Date) & "\" & MonthName(Month(Date), False)
End If
' Check for day folder and create if needed
fpath = "H:\TEST\" & Year(Date) & "\" & MonthName(Month(Date), False) & "\" & Day(Date)
If Len(Dir(fpath, vbDirectory)) = 0 Then
MkDir fpath
DoCmd.OutputTo acOutputReport, "Changeover Car Report", "PDFFormat(*.pdf)", fpath & "\" & "CCReport" & Day(Date) & "_" & Month(Date) & "_" & Year(Date) & ".pdf", False, "", , acExportQualityPrint
End If
Reportmacro_Exit:
Exit Function
Reportmacro_Err:
MsgBox Error$
Resume Reportmacro_Exit
End Function
For some more background: My table includes a ChangeoverID, Formdate(a date that a corresponding form is completed then recorded in table), Formtime(same as form date but just time), CardID(card scanner id), EmployeeID, CarID, etc. I suppose the time here wont matter because I am aiming to get it reported daily, hopefully without changing the original table, just the report code?
Sorry for the confusion
The issue you're having is because your report itself is not filtered. Try changing the report itself to have a default filter of Formdate = Date -1, which I assume is how you are determining which information counts as "Yesterday."
The other alternative is to open the report with a WhereCondition, then output the open form, then close it. All of that can be done in VBA with a single function. If you need help writing that function, let me know and I'll edit this post.
Apologies guys, I have actually found a solution based on what most of you said. I ended up thinking about a filtering option for my report (especially since I just wanted to grab specifics without manipulating the raw data itself) Going into the report layout view I found the option to sort by date by right clicking the field and selecting one of the many options... "today" was one of them. Then I had the issue of this filter not being loaded on start up of the report... So I enabled that in the properties view which makes everything work as intended! Filter is loaded on startup, every day and the report is auto generated to save on a network share. Thanks for your help, it did lead me on the right track.
I'm thinking this might have to use VBA, but is there any way to create the following sequence of actions within the built-in MS Access macro features?:
Run delete query for table (table1)
Run append query for table1
Table1 is exported where the following are true:
table1 is exported as .xlsx
the date is added to the end of the file name (table1_200414.xlsx)
the file is exported to a specific file path
I've seen step #3 done with VBA, but I'm wanting to be able to copy this macro between databases, so I don't know if the VBA code would be copied by a simple copy-paste of the macro. If it is, then how would you do this in VBA?
The best way to do this is within VBA, not just because I think that step 3 can only be done using VBA, but also because you get error handling. And also, if you use in line SQL statements to perform your deletes/appends, you don't need to worry about copying extra queries over to another database - you just copy over the procedure.
Here is a short VBA procedure that performs all 3 steps for you:
Sub sExportData()
On Error GoTo E_Handle
Dim strFolder As String
Dim strFile As String
Dim strID As String
CurrentDb.Execute "DELETE * FROM [Table1];"
CurrentDb.Execute "INSERT INTO [Table1] SELECT * FROM [TableAppend];"
strFolder = "J:\downloads\"
strID=DLookup("ID","Table1")
strFile = "Table1_" & strID & Format(Date, "yymmdd") & ".xlsx"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "Table1", strFolder & strFile, True
sExit:
On Error Resume Next
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "sExportData", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub
Without knowing exactly what you are doing, it may be that you don't need to do the delete/append to Table1. It may be possible to output the data selected in the append query directly to an Excel file.
Regards,
I am trying to create a file using VBA, name the file and embed a date into the filename. In Mac Excel 2011, if "wb" were the reference for the newly created workbook, it would have been no problem to say...
wb.SaveAs Filename:="Old_New_Cust" & Cstr(Date) & ".xlsm", FileFormat:=52
In Excel 2016 and El Capitan, this particular line gives an error saying the file has been saved as a 9-digit number which I can never find.
Whenever I use the FileFormat parameter, this results in an error so I dropped it for experimentation purposes. I have tried putting the entire filename (including the date) into a string variable and running...
wb.SaveAs Filename:=xxx, := FileFormat:=52 with xxx being the unquoted variable name referring to the filename. This interprets the variable name as a literal.
The same result with "\FileNameString", "$FileNameString", "FileNameString", "/$FileNameString", Application.Evaluate(FileNameString), [FileNameString]. Either I get an error message stating the file can't be saved, the file is saved as a nine-digit integer, or the VBA won't execute the line.
The only way I can get this to work is to use a literal for the file name without trying to execute any functions such as "Date" or "Cstr(Date)" in the line. Does anybody know how to either execute a function (like we used to be able to) or get a string from a variable name while using the FileName parameter?
Here is something I use,
Sub G5()
Dim Path As String
Dim filename As String
Path = "C:\Users\ME\Documents\Testing\" & _
Range("G5") & "\" & theMonth & "\" 'change this path to whatever destination you want the files saved to
filename = Range("G5")
ActiveWorkbook.SaveAs filename:=Path & filename & "-" & Format(Date, "mmddyyyy") & ".xlsm", FileFormat:=52
End Sub
I'm having an issue. Currently I have a couple vb modules working off one another that when executed will increment a drop down list, save a version of each option on the drop down list, and print out a copy as well.
Right now I'm using this filepath.
Sub G5()
'Update 20141112
Dim Path As String
Dim filename As String
Path = "C:\Users\MY.Name\Documents\Testing\" & _
Range("G5") & "\"
filename = Range("G5")
If ActiveSheet.Range("G5").Value = "" Then End
If ActiveSheet.Range("G5").Value = "NAMES" Then Exit Sub
ActiveWorkbook.SaveAs filename:=Path & filename & "-" & Format(Date, "mmddyyyy") & ".xlsm", FileFormat:=52
End Sub
So cell G5 contains the name (Last, First) of the person whose voucher this is. Each name is data validated and is identical to the name of their individual folder. Currently the script will save to their folder, but within those folders are 12 sub folders, one for each month. Is there any way for me to get the files to save into the correct month folder?
Cell I10 is the only cell that mentions the month by name, but in the format of "June Transit Reimbursement"
Any help would be appreciated. The script above runs in conjunction with two others, and although its doing 95% of what I need it to do, if I can get past this final hurdle the process will be 100% automated.
I'm trying to read through Like Operators and Option Compare Statements, but I'm struggling, and after reading so many posts here am hoping someone can help
Get the month by taking the first word from I10 and then put it in the file path assuming your folders use the same name formats that show up in I10.
parts = Split(Range("I10"), " ")
theMonth = parts(0) & " " & parts(1)
Path = "C:\Users\MY.Name\Documents\Testing\" & Range("G5") & "\" & theMonth & "\"
Updated to use first 2 words from cell using Mat's Mugs comments.
I wrote the following code so that when an Excel spreadsheet is closed it will update its name with the current date and time:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If ThisWorkbook.Name = "Name_Last Opened-" & Format(Date, "MM-DD-YYYY") & _
"_" & Format(Time, "HH.MM") & ".xls" Then
Else
ThisWorkbook.SaveAs Filename:="\\C:\... Name_Last Opened-" & _
Format(Date, "MM-DD-YYYY") & "_" & Format(Time, "HH.MM") & ".xls"
FName = Sheets("Name").Range("D1").Text
Kill FName
End If
End Sub
Private Sub Workbook_Open()
Range("A1").Select
ActiveCell.FormulaR1C1 = ThisWorkbook.Name
End Sub
Additionally, the code is located within VBAProject(Name of file), under MS Excel Object - ThisWorkbook.
This code works perfectly for me or the workstation that it was created on; however, it does not execute for anyone who opens it on their worstation. Would anyone know how to get the code to execute whenever the spreadsheet is opened and closed from any computer, not just mine?
Thank you,
DFM
It's possible that Excel's security settings aren't allowing other people's computers to run the script that could be interpreted as risky malware. Perhaps you changed your security settings so long ago that you forgot about it. See if you can modify another user's security settings to see if that will make the macro execute on the workbook close.
"Would anyone know how to get the code to execute whenever the spreadsheet is opened and closed from any computer, not just mine?"
I don't think it can be done with 100% certainty unless you can ensure that every possible user will have macro security set such that your macro can execute.
Assuming you can get past that one, you should perhaps check that the users all have the worksheet in the same hard-coded path on C:\ that you seem to be using. What happens if they open the workbook from a different location?
Also:
FName = Sheets("Name").Range("D1").Text
is getting a value from one place and
Range("A1").Select
ActiveCell.FormulaR1C1 = ThisWorkbook.Name
is putting it in another.
I think I'd try something like the following (which assumes from your code that you actually only want to change the file name if it has not changed since the minute of the current time changed):
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim dateTime As String
Dim oldPath As String
Dim newPath As String
dateTime = Format(Now, "MM-DD-YYYY_HH.MM") ' Format the while thing in one string - once
With ThisWorkbook
oldPath = .FullName ' what is it called now, and where did it come from?
newPath = .Path & "\" & "Name_Last Opened-" & dateTime & ".xls" ' what should it be called now?
If oldPath <> newPath Then ' only do something if not saved in last minute - is that what you really want?
.SaveAs Filename:=newPath
Kill oldPath
End If
End With
End Sub
Date() function needs administrator access to run.. so if your user is a non admin, then it will fail. Instead use now(). Most of the times this is some thing which we usually forget as we(people developing the tool) have admin access over our PC's
Fundamentally, you cannot ensure that all users will a) have a macro security setting of low or medium, and b) if set to medium, enable them when the file is opened.
Creating your own certificate would seem like the obvious answer, but in practice I find that the resultant messages and warnings are even more confusing/frightening for some end users, leading to much the same situation as with macro security. Third-party certificates avoid this, but are $$$ and almost surely overkill for an Excel workbook in a corporate environment.
What I've done where I need users to have VBA enabled is to set all sheets to xlveryhidden on save, except a custom locked sheet that only has a note saying macros must be enabled and a brief guide on how to do this. This sheet is hidden and the others restored by the workbook's workbook_open procedure, something that of course will not fire if VBA is disabled.