Force-quit when external xlsm libraries are referenced and open - vba

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

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....

VBA - A document with the name '' is already open

I have written a macro in Excel that I assigned to a button in a workbook. When pressed it asks a user for a file, opens that file and copies the contents into the sheet2 in the original workbook, then saves the original workbook under a new name. It then creates a new button on the worksheet to run another subroutine. When pressing the button a window pops up saying "A document with the name (document name) is already open. Is there anyway to resolve this? I assume this is happening because I'm saving the original workbook under a new name.
Sub openFile()
Dim tempWB As Object, btn As Button, desktopPath As String
fileToOpen = Application.GetOpenFilename(Title:="Select transaction history export:")
If fileToOpen <> False Then
Set tempWB = Workbooks.Open(Filename:=fileToOpen)
End If
If fileToOpen = False Then
End
End If
ActiveSheet.Cells.Copy
Workbooks("Test.xlsm").Sheets("Sheet2").Activate
ActiveSheet.Cells.ClearContents
ActiveSheet.Cells(1, 1).Select
ActiveSheet.Paste
tempWB.Close
Set btn = ActiveSheet.Buttons.Add(650, 50, 100, 40)
With btn
.OnAction = "action"
End With
desktopPath = (MacScript("(path to desktop from user domain as string)") & ":")
ActiveWorkbook.SaveAs Filename:=(desktopPath & "Result" & VBA.format(Date, "mm/dd/yy") & ".xlsm")
End Sub
Sub action()
Range("A1:B1").Font.Size = 14
End Sub

vba check if a read-only workbook is opened

I cannot seem to get a definite feedback on whether or not a read-only workbook is opened or not. In my code I have it copy after closing/saving the workbook. I would like to be able to overwrite the read-only workbook if it's opened as read-only by another user. I tried this something like this bit of code, but had no luck, it just kept saying "File not open!" even when I had it opened.
How can I check whether or not a "read-only .xlsx" file is opened or not in vba?
Sub Test_If_File_Is_Open_2()
Dim wBook As Workbook
On Error Resume Next
Set wBook = Workbooks("C:\Users\" & Environ("username") & "\Documents\Dropbox\Systems\Open Machine Schedule\Open Machine Schedule.xlsx")
If wBook Is Nothing Then 'Not open
MsgBox "File is Not open!"
Else 'It is open
MsgBox "File is Open!" 'Never get this to display when I have the excel file open
End If
End Sub
What started the prompt for using this bit of code(above) was because I wanted the macro to not cause an error if the read-only workbook was opened by another user. When I run the macro below and have the copied read-only workbook opened prior, I get an error:"vba run time error 1004 cannot access read-only document"
I don't get this error when the copied workbook is closed, it overwrites it like it's supposed to.
Here is the code that prompted this question:
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim backupfolder As String
backupfolder = "C:\Users\" & Environ("username") & "\Documents\Dropbox\Systems\Open Machine Schedule\"
ThisWorkbook.SaveAs Filename:=backupfolder & "Open Machine Schedule - Current.xlsx", FileFormat:=xlOpenXMLWorkbook
End Sub
Sub Auto_Save()
Dim savedate
savedate = Date
Dim savetime
savetime = Time
Dim formattime As String
formattime = Format(savetime, "hh.MM.ss")
Dim formatdate As String
formatdate = Format(savedate, "DD - MM - YYYY")
Application.DisplayAlerts = False
Dim backupfolder As String
backupfolder = "C:\Users\" & Environ("username") & "\Documents\Dropbox\Systems\Open Machine Schedule\"
ActiveWorkbook.Save
ActiveWorkbook.SaveAs backupfolder & "Open Machine Schedule - Current.xlsx", FileFormat:=xlOpenXMLWorkbook
SetAttr backupfolder & "Open Machine Schedule - Current.xlsx", vbReadOnly
Application.DisplayAlerts = True
MsgBox "Backup Run. Please Check at: " & backupfolder & " !"
End Sub
Any help/suggestions would be much appreciated
your first code is only testing to see if a workbook exist not its state.
You could use this instead:
If wBook.ReadOnly Then
MsgBox "File is Read-only"
Else
MsgBox "File is not read-only"
End If

Macro runs only once

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?