Macro runs only once - vba

I have a "master" timesheet macro which users open and complete. Upon close I force a macro (in ThisWorkbook) to run and rename the master to a filename held in range save name.
This works perfectly the first time the user opens Excel, edits and closes the workbook. However, if the user opens "master" timesheet the second time, completes another timesheet and closes, without closing Excel in between, then the macro does not run.
I have searched extensively to see if there is some "global variable" that I need to reset but with no joy.
Here is the code. Any advice would be appreciated.
Private Sub Workbook_BeforeClose(SaveAsUI As Boolean)
If Not SaveAsUI Then
Cancel = True
Application.EnableEvents = False
MSG1 = MsgBox("This File will be saved as....... " & Sheets("Timesheet").Range("savename").Value & ".xlsm", vbOKOnly, "Confirm")
Me.SaveAs Filename:=ThisWorkbook.Path & "\" & Sheets("Timesheet").Range("savename").Value & ".xlsm"
ActiveWorkbook.Close False
Application.EnableEvents = True
End If
End Sub

#Bob, seems as if this has something to do with the BeforeClose event. Before closing the workbook, you're trying a SaveAs. This could cause some issues. Did you try to debug this macro? If yes, what did you found?

Related

Application WorkbookOpen Event On Active UserForm

I'm going to try to summarize it. (Excel 2013)
I have created a Form+VBA project that does the following when you open the File: I check to see if it is the only workbook and if it is not then I remind the user to use a shortcut that I created that opens the file on its own instance. If it is on its own instance, It launches a Form, it makes the form unmovable, it also cancels the X button. Pretty much an "always on top of this instance of excel" form.
Private WithEvents App As Application
Private Sub Workbook_Open()
Set Wb = ThisWorkbook
If Application.Workbooks.Count > 1 Then
MsgBox "Please use the shortcut to open this file"
Application.DisplayAlerts = False
Wb.Close False
Else
Set App = Application
UserForm1.Show
End If
End Sub
I added triggers/event that when you open a New Workbook or an Existing workbook on the same instance it closes them and it opens them on a separate instance. Again this is because the form is "always on top".
Private Sub App_NewWorkbook(ByVal Wb As Workbook)
Set cwb = ThisWorkbook
If Wb.Name <> cwb.Name Then
Dim exDir As String, opFile As Variant
Application.DisplayAlerts = False
Wb.Close False
exDir = "C:\Program Files (x86)\Microsoft Office\Office15\EXCEL.EXE"
opFile = Shell("""" & exDir & """ /X", vbNormalFocus)
Application.DisplayAlerts = True
End If
End Sub
Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
Set cwb = ThisWorkbook
If Wb.Name <> cwb.Name Then
Dim fDir, exDir As String, opFile As Variant
fDir = Wb.Path & "\" & Wb.Name
Application.DisplayAlerts = False
Wb.Close False
exDir = "C:\Program Files (x86)\Microsoft Office\Office15\EXCEL.EXE"
opFile = Shell("""" & exDir & """ /X """ & fDir & """", vbNormalFocus)
Application.DisplayAlerts = True
End If
End Sub
It works fine, up to a point.
Here is the issue: When the UserForm is closed, both triggers/events work fine for when you open a New Workbook or an Existing File, when the UserForm is active only the trigger for the New Workbook works. If I try to open another excel file it tries to open the file on the existing instance.
Well after fighting with it for more time I figured out the problem. When the form is active and you want to open an existing file, excel doesn't let the new file Open at all, therefore it never triggers the WorkbookOpen event, because the form is open. The NewWorkbook event works fine because is triggered when excel tries to open a NewWorkbook.
The way I got this to be fixed is by Allowing interaction between the Form and Excel using the vbModeless property on the UserForm1.Show command. This allows the excel window to be used while having the UserForm opened. Since I am making the form unmovable, non closable and I also resize excel to the same size as the form, this works for me. Now all evens trigger because the main Excel window can do everything, and therefore it triggers the WorkbookOpen events as well.

VBA Excel - to exit sub when user cancels GetSaveAsFilename pop up box

I wrote a code which assigns to a button. When the button is pushed, it creates a new workbook and asks the user where to save the new file.
I want to make sure that if the user clicks cancel then it closes the new workbook and exits the sub.
I have wrote it as below but I don't know how to write a better code. I know that the if can be improved.
Option Explicit
Sub Create_a_new_workbook_and_save_it()
Dim xlPath As String
Workbooks.Add
Application.DisplayAlerts = False
xlPath = Application.GetSaveAsFilename(Title:="Select where you want to save your file") & "xlsm"
If xlPath = "Falsexlsm" Then
ActiveWorkbook.Close
Exit Sub
End If
ActiveWorkbook.SaveAs _
Filename:=xlPath, FileFormat:=52
Application.DisplayAlerts = True
End Sub
The above code working fine as you want....

Suppress "Save As" prompt

I looked this topic up and found some help but the suggestions do not seem to be working.
I am opening a CSV file into EXCEL make some changes and then want to save the results back to the same file name and the CSV format.
I want to do this without the prompt that I am getting to make sure I want to save the file.
We are using a macro enabled excel file to import the data make changes and then save.
This whole process with initiated by a batch file that will open the Excel application and the designated file at regular period of time so that is why we do not want the prompt to stop the process.
Here is the code I am using in VBA to do the work, as well as the other subs I found that were suppose to help me suppress the prompt.
This code is in the TheWorkbook of the file and not a module.
Am I missing something?
code
Sub fixfile()
Const strFileName = "W:\Webshare\Documents Acquired in 2017\Jim Excel\snr-room-schedule.csv"
Dim wbkS As Workbook
Dim wshS As Worksheet
Dim wshT As Worksheet
Set wshT = Worksheets.Add(After:=Worksheets(Worksheets.Count))
Set wbkS = Workbooks.Open(Filename:=strFileName)
Set wshS = wbkS.Worksheets(1)
wshS.UsedRange.Copy Destination:=wshT.Range("A1")
wbkS.Close SaveChanges:=False
'This is the area of work that we doing to the data
'Through here
Application.DisplayAlerts = False 'IT WORKS TO DISABLE ALERT PROMPT
ActiveWorkbook.SaveAs Filename:= _
"W:\Webshare\Documents Acquired in 2017\Jim Excel\snr-room-schedule.csv", FileFormat _
:=xlCSVMSDOS, CreateBackup:=False
Application.DisplayAlerts = True 'RESETS DISPLAY ALERTS
Application.Quit
End Sub
Private Sub Workbook_Open()
fixfile
End Sub
Sub CloseandSave()
ActiveWorkbook.Close SaveChanges:=True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Save
End Sub
The problems in your code are due to the following.
When you call SaveAs on the macro-enabled workbook, you had already appended a worksheet to it:
Set wshT = Worksheets.Add(After:=Worksheets(Worksheets.Count))
and then you're trying to save it as csv, which is a text file with only one worksheet, so Excel complains that you will loose information.
Moreover, you're doing the update to the csv twice: once in the
ActiveWorkbook.SaveAs Filename:= ...
Where, as a result, the current workbook becomes the saved workbook, and then again in the Workbook_BeforeClose. In the latter you dont disable the alerts, but anyway there's no need to save again.
I have come to the conclusion that what you want is to use the macro-enabled wb just as a utility for calculation, and you care only for updating the CSV workbook.
For simplicity, we will disable the alerts for the whole session, because the macro-enabled WB is used as a utility and we dont want the batch job to stop for any reason. However you can do it the traditional way, before and after saving, if you feel more comfortable with it.
' Code module ThisWorkbook
Option Explicit
Private Sub Workbook_Open()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
fixCSVFile
' Do the following only if you want the macro-enabled WB to keep
' a copy of the CSV worksheet. but my feeling is you dont want to
' ThisWorkbook.Save
'''''''''''''''''''''
Application.Quit
End Sub
Sub fixCSVFile()
Const strFileName = "W:\Webshare\Documents Acquired in 2017\Jim Excel\snr-room-schedule.csv"
Dim wbkS As Workbook, wshS As Worksheet, wshT As Worksheet
Set wshT = Worksheets.Add(After:=Worksheets(Worksheets.Count))
Set wbkS = Workbooks.Open(Filename:=strFileName)
Set wshS = wbkS.Worksheets(1)
wshS.UsedRange.Copy Destination:=wshT.Range("A1")
wbkS.Close SaveChanges:=False
'This is the area of work that we doing to the data
' For purpose of testing:
wshT.Range("A1").Value = wshT.Range("A1").Value + 1
' Now we will export back the modified csv
wshT.Move '<- Here we have a temporary workbook copy of the modified csv
With ActiveWorkbook
.SaveAs Filename:=strFileName, FileFormat:=xlCSVMSDOS, CreateBackup:=False
.Close False
End With
End Sub
One more thing, the macro-enabled WB is now such that it closes as soon as it opens so it will be difficult to edit or modify (although there are workarounds). Therefore you should save a back-up copy of it without the Application.Quit, as a testing/maintenance copy. Only the copy that you put in production for the sake of the batch job should have the Application.Quit statement.
Based on the comment in the answers that the reason for opening the file and immediately saving it with no other changes...
So we needed to do what we were doing to get the file edit date to
change but not the actual file.
...this is a complete X-Y problem. If you need to change a file's modified time, just change the file's modified time instead of jumping through all of the opening and re-saving hoops:
Sub UpdateFileModifiedDate()
Const filePath = "W:\Webshare\Documents Acquired in 2017\Jim Excel\snr-room-schedule.csv"
Dim handle As Integer
handle = FreeFile
Open filePath For Binary As #handle
'Read the first byte.
Dim first As Byte
Get #handle, 1, first
'Write it back
Put #handle, 1, first
Close #handle
End Sub
This will be insanely faster than your current process, will only set the file modified date and time to the time that you run the Sub, and doesn't risk any of the other issues you can run into cycling a CSV file through Excel (date formats and locale issues, truncating decimals, conversions to exponential notation, etc., etc.).
since you're going to consciously overwrite an existing file you can just:
first delete it with a Kill command
then do the SaveAs
so change this code section:
'This is the area of work that we doing to the data
'Through here
Application.DisplayAlerts = False 'IT WORKS TO DISABLE ALERT PROMPT
ActiveWorkbook.SaveAs Filename:= _
"W:\Webshare\Documents Acquired in 2017\Jim Excel\snr-room-schedule.csv", FileFormat _
:=xlCSVMSDOS, CreateBackup:=False
Application.DisplayAlerts = True 'RESETS DISPLAY ALERTS
Application.Quit
to this:
'This is the area of work that we doing to the data
'Through here
Kill strFileName '<-- delete the old file
ActiveWorkbook.SaveAs Filename:= _
"W:\Webshare\Documents Acquired in 2017\Jim Excel\snr-room-schedule.csv", FileFormat _
:=xlCSVMSDOS, CreateBackup:=False
Application.Quit
furthermore your code can be refactored by properly handling the ActiveWorkbook and ActiveSheet objects and reduce the variables and code amount, like follows:
Sub fixfile()
Const strFileName = "W:\Webshare\Documents Acquired in 2017\Jim Excel\snr-room-schedule.csv"
Workbooks.Open(Filename:=strFileName).Worksheets(1).UsedRange.Copy Destination:=Worksheets.Add(After:=Worksheets(Worksheets.Count)).Range("A1") '<--| open 'strFileName', reference and copy its 1st worksheet 'UsedRange' and paste it to a newly added worksheet in the macro workbook. After this statement we're left with the opened workbook as `ActiveWorkbook`
ActiveWorkbook.Close SaveChanges:=False '<--| close `ActiveWorkbook`, i.e. the just opened one. We're left with macro workbook as `ActiveWorkbook` and its newly created worksheet as `ActiveSheet`
'This is the area of work that we doing to the data
'Through here
ActiveSheet.Move '<--| move `ActiveSheet` (i.e. the newly created sheet in macro workbook) to a "new" workbook having that sheet as its only one. We're left with this "new" workbook as `ActiveWorkbook`
Kill strFileName '<--| delete the "old" 'strFileName'
ActiveWorkbook.SaveAs Filename:=strFileName, FileFormat:=xlCSVMSDOS, CreateBackup:=False '<--| save `ActiveWorkbook` (i.e the "new" one) as the new 'strFileName' file
ActiveWorkbook.Close SaveChanges:=False '<--| close `ActiveWorkbook` (i.e the "new" one) without changes (we just "SavedA"s it)
Application.Quit
End Sub
It seems like you are making changes to two files. In addition to the csv file that you are opening, you appear to be adding a sheet to the excel file that is running the VBA code with these lines:
Dim wshT As Worksheet
Set wshT = Worksheets.Add(After:=Worksheets(Worksheets.Count))
So my guess is that you are indeed suppressing the save prompt for the csv file but you are also getting a save prompt for the changes you made to the excel workbook when you attempt to close it. So I think you need to suppress that prompt as well by also turning off DisplayAlerts in the CloseAndSave sub, or wherever the excel workbook is actually being closed.
I don't get why you are copying the CSV sheet into a new sheet in the macro enabled workbook. This is where your problem starts!
You should just be dealing with the data in wshS and saving wbkS instead.
Done, no more problems.
When you call
ActiveWorkbook.SaveAs Filename:= _
"W:\Webshare\Documents Acquired in 2017\Jim Excel\snr-room-schedule.csv",
FileFormat:=xlCSVMSDOS, CreateBackup:=False`
you're renaming the current macro enabled file within excel to the CSV file as far as Excel sees it.
When Application.Quit is called, it is going to call
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Save
End Sub
Which is where the prompt that you are complaining about is happening.
Even if you remove it, after Workbook_BeforeClose is called, Excel is still going to check all the open files' .Saved flag.
Excel will prompt you to save any files where .Saved = False
But if you set ThisWorkbook.Saved = True then Excel will close the file without asking to save.
Solution:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Saved = True
End Sub

Force-quit when external xlsm libraries are referenced and open

I have three files, one is app.xlsm, the other one is lib.xlsm, whereas app.xlsm uses lib.xlsm as a reference (which is specified in Tools -> References). The third, third.xlsm has the following code:
Private Sub Workbook_Open()
prompt = MsgBox("If you click Ok, Excel will force close." & vbCrLf & _
"If you click Cancel, you can work with the file", vbOKCancel)
If prompt = vbOK Then
Application.DisplayAlerts = False
thisworkbook.Close True
Application.Quit
End If
End Sub
Assume that I have app and lib open. Now when I open third, and then click OK at the prompt, app gets closed but lib remains open. I.e. Excel does not get force shut.
I need Excel to close all files without saving them and close silently.
Many thanks.
What happens if you loop through the open workbooks in this instance, ie
Private Sub Workbook_Open()
Dim wb As Workbook
prompt = MsgBox("If you click Ok, Excel will force close." & vbCrLf & _
"If you click Cancel, you can work with the file", vbOKCancel)
If prompt = vbOK Then
For Each wb In Application.Workbooks
If wb.Name <> ThisWorkbook.Name Then wb.Close False
Next
End If
ThisWorkbook.Saved = True
Application.Quit
End Sub
thermonuclear option to close all Excel instances
Private Sub Workbook_Open()
Dim wb As Workbook
prompt = MsgBox("If you click Ok, Excel will force close." & vbCrLf & _
"If you click Cancel, you can work with the file", vbOKCancel)
If prompt = vbOK Then
For Each wb In Application.Workbooks
If wb.Name <> ThisWorkbook.Name Then wb.Close False
Next
End If
X2 = Shell("powershell.exe kill -processname excel", 1)
End Sub

excel vba to reopen excel file without saving

I have the following code, it is about to reopen the current excel file.
Sub CloseMe()
Application.OnTime Now + TimeValue("00:00:02"), "OpenMe"
ThisWorkbook.Close False
End Sub
Sub OpenMe()
MsgBox "The file is reopened"
End Sub
I am trying to make it applicable to activeworkbook, so i change
ThisWorkbook.Close False
to
ActiveWorkbook.Close False
but it ended up close the activeworkbook but didnt reopen the file, any advise? Very sorry if this question seem silly to you.
Try this:
Sub ReOpen()
Application.DisplayAlerts = False
Workbooks.Open ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
Application.DisplayAlerts = True
End Sub
I think there's a thought error ... when the workbook is closing, the contained VBA code is closing as well, so there's no code left to be executed 2 seconds later, and no object that would be the subject of any code.
This will only work if your closing/reopening logic is outside the sheet you want to close/reopen, and to be more specific, residing in a workbook that remains open all the time between closing/reopening the sheet you want to reopen.
I like this, which I adapted from "How To Close And Reopen Active Workbook?"
Sub ReOpen()
ActiveWorkbook.ChangeFileAccess xlReadOnly, , False
Application.Wait Now + TimeValue("00:00:01")
ActiveWorkbook.ChangeFileAccess xlReadWrite, , True
End Sub
It seems more elegant to me and warns if there are unsaved changes. While the original uses ThisWorkbook, I use ActiveWorkbook like #Taosique.