I can't get my macro running in AfterSave or BeforeClose event.
I export one sheet to a .csv file, that's already working well with the next code when I link this macro to a button:
Sub CopyToCSV()
Worksheets("LastLots").UsedRange.Rows("1:5").Calculate
ThisWorkbook.Save
Dim MyPath As String
Dim MyFileName As String
'The path and file names:
MyPath = "D:\Data\PW\2018\"
MyFileName = "LastLots-exported"
'Makes sure the path name ends with "\":
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
'Makes sure the filename ends with ".csv"
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
'Copies the sheet to a new workbook:
Sheets("LastLots").Copy
'The new workbook becomes Activeworkbook:
With ActiveWorkbook
Application.DisplayAlerts = False
'Saves the new workbook to given folder / filename:
.SaveAs Filename:= _
MyPath & MyFileName, _
FileFormat:=xlCSV, _
CreateBackup:=False
'Closes the file
.Close False
Application.DisplayAlerts = True
End With
End Sub
The code above is in a module. As I said, when linked to a button and press that button, it works very well.
But I want it running when the user saved the file.
Fot this, I put the next code in ThisWorkbook:
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
If Success = True Then
Call CopyToCSV
End If
End Sub
I tried various things, like putting the code of the macro inside the AfterSave-event, and disable/enable Application.EnableEvents before and after calling CopyToCSV but nothing works for me...
Does anyone have a suggestion? I'm out of mind, and every topic I find on Google say to put the code in ThisWorkbook, but already done that.
Just typing the code somewhere does not make it an event handler.
You must enter "ThisWorkbook", look at the top bar, select "ThisWorkbook" and the desired event.
Excel will then automatically create the empty Sub for you, associated with the event. You insert your code inside that Sub.
More details: https://www.excelcampus.com/vba/code-modules-event-procedures/
Hints: before any if, test if the script is being run, add a message such as MsgBox "After save!!!"
This will help you identify if the problem is the event not being called or your code not being run properly.
Related
I get a runtime error with ws.copy -> without the code works but just creates an empty workbook.
Sub SaveWorksheetAsXlsx(ws As Worksheet)
Dim filePath As String
filePath = ThisWorkbook.Path & "\" & ws.Name & ".xlsx"
' Create a new workbook
Dim newWorkbook As Workbook
Set newWorkbook = Workbooks.Add
' Copy the worksheet to the new workbook
ws.Copy 'After:=newWorkbook.Worksheets(1)
' Save the new workbook
newWorkbook.SaveAs filePath, FileFormat:=xlOpenXMLWorkbook
newWorkbook.Close SaveChanges:=False
End Sub
Copy Sheet to a New Workbook
If you replace As Worksheet with As Object, the procedure will also work for charts.
To reference the last opened workbook, you can safely use Workbook(Workbooks.Count).
Turn off Application.DisplayAlerts to overwrite without confirmation. If you don't do this, when the file exists, you'll be asked to save it. If you select No or Cancel, the following error will occur:
Run-time error '1004': Method 'SaveAs' of object '_Workbook' failed
If your intent is to reference the sheet's workbook, you can use the .Parent property. Then the procedure will not be restricted just to the workbook containing this code (ThisWorkbook). Otherwise, replace Sheet.Parent with ThisWorkbook.
If you instead of the backslash (\) use Application.PathSeparator, the procedure will also work on computers with a different operating system than Windows.
For a new workbook, the default type is .xlsx so you don't need to specify the file extension or format.
Sub SaveSheetAsXlsx(ByVal Sheet As Object)
' Copy the sheet to a new single-sheet workbook.
Sheet.Copy
' Reference, save and close the new workbook.
Dim nwb As Workbook: Set nwb = Workbooks(Workbooks.Count)
Application.DisplayAlerts = False ' overwrite without confirmation
nwb.SaveAs Sheet.Parent.Path & Application.PathSeparator & Sheet.Name
Application.DisplayAlerts = True
nwb.Close False
End Sub
set newWorkbook = workbooks.Add creates a new workbook. But ws.Copy without arguments copies ws to a new workbook. Now you have two new workbooks which is clearly not what you intend. MS learning documents gives an example of how to do copy a worksheet in its documentation on the copy command. Reference: https://learn.microsoft.com/en-us/office/vba/api/excel.worksheet.copy
Sub foo()
Call SaveWorksheetAsXlsx(Worksheets("Sheet3"))
End Sub
Sub SaveWorksheetAsXlsx(ws As Worksheet)
Dim filePath As String
filePath = ThisWorkbook.Path & "\" & ws.Name & ".xlsx"
If Not CreateObject("Scripting.FileSystemObject").FileExists(filePath) Then
ws.Copy
ActiveWorkbook.SaveAs filePath, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close SaveChanges:=False
Else
MsgBox "Error: unable to save file. File already exists: " + filePath
End If
End Sub
This obviously relies on the expected behavior that when you copy a worksheet to a new workbook that workbook becomes the active workbook. I have used this before without any problems (for many years I guess), although it does make me a little nervous relying on default behaviors. So you may consider adding some guard clauses, perhaps only saving the workbook if it has an empty path (i.e., ensure it is a newly added workbook -> if ActiveWorkbook.Path = "". So, coding prophylacticly and very cautiously:
Sub foo()
Call SaveWorksheetAsXlsx(Worksheets("Sheet3"))
End Sub
Sub SaveWorksheetAsXlsx(ws As Worksheet)
Dim filePath As String
filePath = ThisWorkbook.Path & "\" & ws.Name & ".xlsx"
If Not CreateObject("Scripting.FileSystemObject").FileExists(filePath) Then
ws.Copy
If ActiveWorkbook.Path = "" Then 'Extra check to ensure this is a newly created and unsaved workbook
ActiveWorkbook.SaveAs filePath, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close SaveChanges:=False
Else
MsgBox "Unexpected error attempting to save file " + filePath
End If
Else
MsgBox "Error: unable to save file. File already exists: " + filePath
End If
End Sub
I am trying to save my workbook every 10 minutes but I keep getting the run time error 1004. The code shown is in one of the modules. My program will save my entire workbook as today's date into a folder.
Everything was working perfectly fine until I ran the code and then saved it and now I get that error.
Sub CommandButton1_Click()
Dim path As String
Dim filename1 As String
path = "C:\Users\100020427\Desktop\FPYFiles\"
filename1 = ThisWorkbook.Sheets("Totals").Range("M10").Text
Application.DisplayAlerts = False
If ThisWorkbook.Name = filename1 Then
ThisWorkbook.save
MsgBox "Today's Form has been saved! Click Ok Button"
Else
ThisWorkbook.SaveAs Filename:=path & filename1, FileFormat:=52, CreateBackup:=False
MsgBox "Today's Form has been saved! Click Ok Button"
Application.DisplayAlerts = True
End If
'Application.DisplayAlerts = False
'ActiveWorkbook.save Filename:=path & filename1, FileFormat:=52, CreateBackup:=False
'Application.DisplayAlerts = True
Application.OnTime Now + TimeValue("00:01:00"), "CommandButton1_Click"
End Sub
Sub Workbook_Open()
CommandButton1_Click
Application.OnTime Now + TimeValue("00:01:00"), "CommandButton1_Click"
End Sub
I expect is to save workbook as the date in the listed location
If I understand your setup correctly, you are issuing a SaveAs-command every 10 minutes, and the filename will contain the current date. So, the filename is the same during the whole day, and that will cause a failure when the SaveAs is issued a second time.
Why? You ask Excel to overwrite an existing file. As you suppress warnings, you will not see the message "The file already exists, do you want to replace it?". Excel then tries to overwrite the last version of the file with the current one, but as the file is (obviously) open, this will fail.
Change your piece of code so that the SaveAs is only executed if you really write a new file. In all other cases, use Save rather than SaveAs. Note that I added the extension to the filename so that the check is successfull. I also fully qualified the cell where the filename is expected so that the code will not fail when a different sheet or workbook is currently active.
fileName1 = ThisWorkbook.Sheets(1).Range("M10") & ".xlsm"
If ThisWorkbook.Name = fileName1 Then
ThisWorkbook.Save
Else
ThisWorkbook.SaveAs path & fileName1, 52
End If
Everytime I save my workbook I need to save the same workbook, but Hidden.
Now I have this code
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
ThisWorkbook.Saved = True
On Error Resume Next
If Not (Left(ThisWorkbook.Name, 2) = "Z_") Then
Application.DisplayAlerts = False
ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\Z_" & ThisWorkbook.Name
SetAttr ThisWorkbook.Path & "\Z_" & ThisWorkbook.Name, vbHidden
Application.DisplayAlerts = True
End If
SetAttr ThisWorkbook.Path & "\Z_" & ThisWorkbook.Name, vbHidden
End Sub
However it works only every second time. First time I save WB, it creates the file and make it hidden, but when I save it second time it deletes the hidden file.
When I use SaveAs with overwrite property it saves file and activate it, but I dont want that.
Why is that? How to solve this please?
When you have a problem like this, the first this to do is to comment out On Error Resume Next and Application.DisplayAlerts = False. That will give you far more information on what's going on.
In your case, you had a problem with preexisting files. Try this instead:
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim HiddenFileName As String
HiddenFileName = ThisWorkbook.Path & "\Z_" & ThisWorkbook.Name
ThisWorkbook.Saved = True
On Error Resume Next
If Not (Left(ThisWorkbook.Name, 2) = "Z_") Then
Application.DisplayAlerts = False
' Unhide and delete existing file
SetAttr HiddenFileName, vbNormal
Kill HiddenFileName
' Save new copy and hide it
ThisWorkbook.SaveCopyAs HiddenFileName
SetAttr HiddenFileName, vbHidden
Application.DisplayAlerts = True
End If
SetAttr HiddenFileName, vbHidden
End Sub
It unhides and deletes the file, before creating it again. This is a bit dirty, since it doesn't test if it exists before, but relies on On Error Resume Next.
I am writing a piece of code in Excel VBA in which I needed to create a macro which allows the user to click the ActiveX button as a result of which the file is then saved to a specified location. Once this new file is created, I wanted to code so the new file (which successfully saves in the alternate specified location) does not have the ActiveX Command Button is not present. Also, once the button is clicked from the original file, I wanted to somehow make the master file close and the newly saved file to automatically open. Please can someone help?
Code so far:
Sub CommandButton1_Click()
ActiveSheet.Copy
Dim SaveName As String
SaveName = ActiveSheet.Range("C1").Text
With ActiveWorkbook
.SaveAs "File path Specified" & _
SaveName & ".xls"
.Close 0
End With
End Sub
My first solution (depending on what you really need to do) is the following:
Firstly you will need this:
Me.SaveCopyAs "<full_Path>"
See more on this here: https://msdn.microsoft.com/en-us/library/office/ff835014.aspx
This will create a copy of the file to the specified path with whatever name you want. Before you do that, you could hide your button and then use save as copy to save it with the button hidden.
Finally if you want to close the original and open the copy then you have to give to the copy a different name. Then open the new file and close the original.
Your code should look similar to this:
Sub CommandButton1_Click()
ActiveSheet.Copy
Dim SaveName As String
SaveName = ActiveSheet.Range("C1").Text
With ActiveWorkbook
.Worksheets("<your_worksheet>").CommandButton1.visible = False
.SaveCopyAs "File path Specified" & SaveName & ".xls"
End With
Workbooks.Open ("File path Specified" & SaveName & ".xls")
Workbooks("<Original_name.xlsm>").close False
End Sub
Another Solution could be saving the workbook with SaveAs. Before that save the orginal. Hide the button. And saveas will close the original and open the new one automatically.
Your code should look something like that:
Sub CommandButton1_Click()
ActiveSheet.Copy
Dim SaveName As String
SaveName = ActiveSheet.Range("C1").Text
With ActiveWorkbook
.Save
.Worksheets("<your_worksheet>").CommandButton1.visible = False
.SaveAs "File path Specified" & SaveName & ".xls"
End With
End Sub
I am having this weird problem when saving my sheet into onedrive sync folder. Basically what i am doing with the below code is that I copy a sheet from my workbook then save it into a sync folder. When it does this, a saved copy with the filename that is stored in a specific cell together with another copy with the same saved name with a 1 at the back of the file name will appear in the sync folder. When i step over to test the code, no such error occur. The error only occur if I run the macro. May i know why? Below is my code;
Sub SheetSplit1()
'
'Creates an individual workbook for each worksheet in the active workbook.
'
Dim wbDest As Workbook
Dim wbSource As Workbook
Dim sht As Object
Dim strSavePath As String
Dim sname As String
Dim relativepath As String
Set wbSource = ActiveWorkbook
'For Each sht In wbSource.Sheets
Sheet10.Copy
Set wbDest = ActiveWorkbook
sname = Sheet9.Range("I5") & "_" & _
Format(Sheet9.Range("I8"), "ddmmmyyyy") & ".xlsx"
relativepath = "C:\Users\" & Environ$("Username") & _
"\SharePoint\Open Project Transition Check - Doc\Transition Dashboard Report\" & sname 'use path of wbSource
'wbDest.Sheets(1).Range("A1").Clear 'clear filename from new workbook cell A1
Application.DisplayAlerts = False
ActiveWorkbook.CheckCompatibility = False
ActiveWorkbook.SaveAs Filename:=relativepath, FileFormat:=xlOpenXMLWorkbook, _
CreateBackup:=False
Application.DisplayAlerts = True
wbDest.Close False 'close the newly saved workbook without saving (we already saved)
'Next
MsgBox "DashBoard Report Saved!"
End Sub
Greatly appreciate anyone who could assist me. Thanks.
I wish I could give a definitive answer, or Microsoft would contribute.
I have similar connected problems. It seems that another version of the file may be or "appear to be" open elsewhere, thus preventing excel/Onedrive from completing the save action.
Rather than overwrite it(lets face t, that was the command) it creates a "version" filename(1).
I am guessing this is the same as when you do it manually and you are asked to resolve a conflict.
So far I have failed to find out how you can discover and solve the problem in code.
I solved it in one instance by mapping a drive on the offending desktop and first closing any open versions before save, but that is not a robust long term solution.
Test this by setting Application.DisplayAlerts = True and capturing errors.
"On error got catch" after the last dimension line then
"exit function
catch:
msgbox err.description"
before "end sub"