I am having a lot of difficulty getting a SaveAs command to work properly. For a local hospital, there are patient charts which are created from a template file, in which patient data is entered after which it is manually renamed (using save-As) and then copied to another location as a backup. The template is re-used over and over again.
The goal of my code is this to automate this process. Therefore I want to save to two different locations, starting from a template file. The template file should not be overwritten. In the template, a user sets the department name and bed number in cell K1 and N1 , repectively. These fields determine the folder and filename within that folder.
When the save button is pressed, my code starts to run. I use SaveCopyAs to save the backup file and after that I want to use SaveAs to save to my primary folder. SaveAs should set this new file to be my working file, therefore not overwriting my template. At least this is what I believe...
THE PROBLEM: When running SaveAs, Excel crashes (without any clear error message). The strange thing (to me) is that is does not crash when I replace SaveAs with SaveCopyAs.
THE QUESTION: Why does Excel crash at this point? Is there a way to fix or avoid this behaviour? I cannot find a suitable solution that does not alter my template. Any help or suggestions are more than welcome.
The code below is placed in my "ThisWorkbook" folder and is executed every time I click the "save"-button.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
department = Range("K1").Value 'Name of department: CHIC, THIC, ICB or NCIC
bedNumber = Range("N1").Value 'bednumber or roomnumber: Bed 1. Bed 2 or Room 1, Room 2.
newFileName = department & "\" & bedNumber & ".xls"
If IsEmpty(department) Then
MsgBox "You haven't entered a department. Please try again."
ElseIf IsEmpty(bedNumber) Then
MsgBox "You haven't entered a bed or room number. Please try again."
Else
ActiveWorkbook.SaveCopyAs "C:\myBackupFolder\" + newFileName
End If
ActiveWorkbook.SaveAs "C:\myPrimaryFolder\" + newFileName 'Doesn't work
'ActiveWorkbook.SaveCopyAs "C:\myPrimaryFolder\" + newFileName 'Does work, but I end up with a messed up template!
End Sub
As well as setting Cancel = True to prevent the default save-behaviour, add:
Application.EnableEvents = False
ActiveWorkbook.SaveAs "C:\myPrimaryFolder\" + newFileName 'Doesn't work
Application.EnableEvents = True
to prevent the same procedure being called again (and again..). This is probably why it crashes.
Related
I'm creating a macro where I will need to run it in 1 file (called "Masterfile"), it will open and execute the macro on another file ("SurveyReport") and then give me a message box saying "done!".
The code I have to execute on the SurveyReport file works fine when I open that file manually and execute it. The code I need to open SurveyReport from MasterFile is also working it seems, I ran the below with no issues:
Sub PivotTable()
'
' PivotTable Macro
Dim MasterFile As String
MasterFile = ActiveWorkbook.Name
Dim SurveyReport As String
SurveyReport = Application.GetOpenFilename("Excel files (*.xlsx), *xlsx", 1, "Please select the Survey Create Report file", , False)
Workbooks.Open (SurveyReport)
End Sub
But, when I try to activate the SurveyReport file so I can begin executing the macro in it, I get a "Subscript out of range" error. I've tried using the following code after the above block and before the code to execute in the SurveyReport file:
Windows(SurveyReport).Activate
This didn't work, not did:
ThisWorkbook.Activate
...which only had the effect of activating the MasterFile.
SurveyReport file is a .xlsx file. I tried saving it as a .xls file and amending the code, but no joy.
I also tried passing it the file name directly (i.e. Windows("filename.xlsx").Activate), same issue.
ActiveWorkbook is as it says on the tin - whichever workbook happens to be active when the code runs.
ThisWorkbook is always the workbook that the code is sitting in.
You can SET references to specific workbooks rather than just using their names each time. A name can change, or reference the wrong object.... imagine you have a friend called Darren. Each time you mention him you mention him by name. Someone that doesn't know Darren hasn't a clue which Darren out of all the ones available in the world you're talking about. Now imagine you have a little replica of Darren in your pocket... nah, that's a terrible anology - it wouldn't be a replica, it would be a reference to the real Darren... anyway, I digress.
This code sets a reference to the workbook, you can then use that reference any time you want to refer to the correct workbook:
Sub PivotTable()
Dim MasterFile As Workbook
Dim SurveyRptName As String
Dim SurveyReport As Workbook
Set MasterFile = ThisWorkbook '
SurveyRptName = Application.GetOpenFilename("Excel files (*.xlsx), *xlsx", 1, _
"Please select the Survey Create Report file", , False)
If SurveyRptName <> "False" Then
Set SurveyReport = Workbooks.Open(SurveyRptName)
End If
SurveyReport.Activate 'You don't need this line. It doesn't matter if
'the workbook is active, the code knows which one
'you're talking about in the next line.
MsgBox "This is " & SurveyReport.Name & _
" containing " & SurveyReport.Worksheets.Count & " sheets." & vbCr & _
"The value in cell A1 of the first sheet is " & _
SurveyReport.Worksheets(1).Range("A1")
End Sub
Edit: Of course, if you press Cancel when selecting a file then the lines following the IF...THEN code won't have a reference to work on and you'll get a Object Variable or With block variable not set - best not to run the bottom bit of code if you haven't successfully opened the Survey Report file.
The part of the answer that is missing - is that he tried to call a method of an object when his variable was STRING - the open command and subsequent commands will give you an OBJECT - which has properties and methods like .Activate. The STRING type has no such method or property (to be sure - it may have others).
the solution provided by Darren solves this by declaring his SurveyReport as type Workbook - an object of Excel.
I have a workbook that is connected to a database and when you refresh the workbook, it refreshes your data in the workbook. Afterwards a macro is ran to save the new (raw) data in two different locations, then the macro will do analysis on that raw data, and save the same workbook later on in 4 other locations.
When I am trying to do the first save of the raw data, I am able to save to the first location, but when it moves to the second location I am getting the error: Run-time error '1004': Method 'SaveAs' of object '_Workbook' failed. Both of the locations are valid locations.
Here is one sub in the macro that does the first file save:
Sub saveraw()
Dim rdate As String
Dim rawfilename As String, rawfilename1 As String
Dim mywb As Workbook
Set mywb = ActiveWorkbook
rdate = Format(Now(), "mm-dd-yy")
rawfilename = "\\sw\mes\PS\SC\SCM_Supply_Execution\Spares\This Weeks Number Database\This Weeks Numbers(raw) " & rdate & ".xlsm"
rawfilename1 = "\\sw\mes\PS\SC\SCM_Shared\Spares Reports\This Weeks Numbers(raw) " & rdate & ".xlsm"
mywb.Save
Worksheets("Sheet2").Range("A2") = Null
Application.DisplayAlerts = False
mywb.SaveAs Filename:=rawfilename
mywb.SaveAs Filename:=rawfilename1
Application.DisplayAlerts = True
End Sub
I have also tried using the method of
ActiveWorkbook.SaveAs
in place of both of the mywb.SaveAs, but that did not work either.
As a test, run the code against file locations only YOU have access to. I'm noticing a reference to shared drive on the second command so maybe someone is already in it and it can't be saved over.
Set display alerts to true for now.
Also, When you run the test macro, make sure you don't have any windows explorer windows open and feed back here with results and I'll assist if it debugs again.
On the face of it, the code looks good to me.
Try this
ActiveWorkbook.SaveAs Filename:="\\sw\mes\PS\SC\SCM_Supply_Execution\Spares\This Weeks Number Database\This Weeks Numbers(raw) " & rdate & ".xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled
This might have issues if the file already exists because then a pop-up will ask you if you want to overwrite it or not
Though I think the error is due to an issue with privileges in that specific location or connection issues
I am writing a program that currently, when the user clicks "OK", saves the current file, copies certain values in the file; then pastes the values to a different file. Then both files close. My problem is that it gives me an error:
Run Time Error: 'Application-Defined or Object Defined Error'
It highlights this line:
ThisWorkbook.Worksheets("data").Range("C31", Range("C106").End (xlToRight)).Copy
I separated this line and the one right after it to test it alone and it worked like I wanted to. I tested the rest of the program without those two lines and it worked like I expected it to.
I tried to limit it to just copying one cell and it worked.
I made sure that the name of the sheet was correct.
I tried to just copy one row:
Range("C31", range("C31").End(xlToRight))
it still did not work and I came across the same error message.
I want to say I referenced something wrong but I don't see it.
Any reply at all would be helpful, Thank you.
P.S. I am sorry for redundancy in the code, I don't use "Dim" as much as I should.
Sub Button425_Click()
Dim FName As String
Dim FPath As String
Dim yourmsg As String
Dim testmsg As String
yourmsg = "Are you sure that you want to save and exit?"
testmsg = MsgBox(yourmsg, vbOKCancel + vbExclamation)
FPath = "I:\a\d\f\daily log recycle\"
FName = Sheets("Sheet1").Range("C3").Text
If testmsg = 1 Then
ThisWorkbook.SaveAs filename:=FPath & "\" & FName
Workbooks.Open ("I:\a\d\f\new daily log 1.xlsm")
ThisWorkbook.Worksheets("data").Range("C31", Range("C31").End(xlToRight)).Copy
Workbooks("new daily log 1.xlsm").Worksheets("data").Range("D31").PasteSpecial xlPasteValues
ThisWorkbook.Worksheets("sheet1").Range("E45").Copy
Workbooks("new daily log 1.xlsm").Worksheets("sheet1").Range("E44").PasteSpecial
Workbooks("new daily log 1.xlsm").Worksheets("sheet1").Range("E45").ClearContents
Workbooks("new daily log 1.xlsm").Save
Workbooks("new daily log 1.xlsm").Close
ThisWorkbook.Saved = True
Application.Quit
Else 'do nothing
End If
End Sub
You're mixing a fully addressed range
ThisWorkbook.Worksheets("data").Range("C31"
with a relatively addressed range
Range("C106").End (xlToRight)
Try
ThisWorkbook.Worksheets("data").Range("C31", ThisWorkbook.Worksheets("data").Range("C106").End (xlToRight))
I see a couple of issues:
FPath = "I:\a\d\f\daily log recycle\"
ThisWorkbook.SaveAs filename:=FPath & "\" & FName
When you attempt to save you will have ...\daily log recycle\\<filename>. Remove one of the backslashes \, I'd suggest removing the one in the .SaveAs line.
Then, with these two lines:
Workbooks.Open ("I:\a\d\f\new daily log 1.xlsm")
ThisWorkbook.Worksheets("data").Range("C31", Range("C31").End(xlToRight)).Copy
The ThisWorkbook probably isn't pointing to the one you think it is. On all the following lines you specify Workbooks("new daily log 1.xlsm")., why don't you replace ThisWorkbook with an explicit Workbooks("...") so you can be 100% certain of which of the two open workbooks you're referencing.
I would also do that for these two lines:
ThisWorkbook.Worksheets("sheet1").Range("E45").Copy
ThisWorkbook.Saved = True
Also, just to be clear, ThisWorkbook.Saved = True tells Excel to not prompt you to save the workbook when you close it, but it doesn't actually save the workbook. If you want to actually save it, you'll need to use .Save, just like you do a couple lines above that for Workbooks("new daily log 1.xlsm").Save.
I'm having serious trouble solving this issue:
I have an Excel Workbook (2010 or later) with a Macro that HAS TO run BeforeClose. It deletes internal data and saves this change: (no problem so far)
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim xlSheet As Worksheet
For Each xlSheet In Sheets
If xlSheet.Name = "internalDataSource" Then
MsgBox "Internal data will be deleted from the workbook. Changes are saved."
Application.DisplayAlerts = False
xlSheet.Delete
ThisWorkbook.Save
Application.DisplayAlerts = True
End If
Next xlSheet
End Sub
My Problem:
the user should be able to change something. Now if the user changes something he usually gets asked, if he wants to save the changes. In this version there is no choice, but saving his changes. currently they are always saved.
How can I get the user to be able to say "No, don't save my changes." but still run the macro and save the deletion of internal data afterwards?
I'm desperately looking for a VBA-command to revert all changes to the last saved state. Then I would simply run the Macro from above and save my deletion.
Thanks for any help I get!
This could be done by saving a copy of the workbook each time a normal save is done, move the internal data to the copy, and rename the copy as the original. There are few options for how to do this specifically, I'll post some suggestions here to flush out my answer:
Saving a copy could be placed in the Workbook_BeforeSave event.
Renaming the copy to the original could be done in the Workbook_BeforeClose procedure you have listed here.
To run a messagebox past the user, you may consider editing the MsgBox you have listed to something like:
If (MsgBox("You are attempting to exit." & vbNewLine _
& "All changes since the last save will be lost." & vbNewLine _
& "Okay to proceed?", 308) = vbNo) Then
Cancel = True
End If
Of course, not "all changes since the last save will be lost" because your internal data will be saved.
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.