Trying to close Excel through an Excel macro? - vba

I made a button (not an activeX button) and assigned a macro that is coded to kill the EXCEL.EXE task. When activated it gives me an error message saying it cannot close. Is it even possible to kill the excel task through excel?
Here's my code. I'm positive it works.
Dim oShell : Set oShell = CreateObject("WScript.Shell")
intAnswer = _
MsgBox("Do you want to close Excel?", _
vbYesNo, "Prompt")
If intAnswer = vbYes Then
MsgBox "Excel will close."
Else
MsgBox "Excel will remain open."
End If
oShell.Run "taskkill /im EXCEL.EXE", , True

Use the Application.Quit method :
intAnswer = _
MsgBox("Do you want to close Excel?", _
vbYesNo, "Prompt")
If intAnswer = vbYes Then
MsgBox "Excel will close."
Application.Quit
Else
MsgBox "Excel will remain open."
End If
Consider to use as well
ThisWorkbook.Save
if you want to save the work before closing the application. You can find out more about the Application object here.

Maybe try adding this up front:
Application.DisplayAlerts=False
ThisWorkbook.Save

Related

How to handle 'No' or 'Cancel' on Workbook.SaveAs overwrite confirmation?

I'm want users to be prompted to save a workbook before the VBA script starts modifying content. When the SaveAs dialog box comes up, if the user clicks Cancel I raise a custom error and stop the script. If they click Save and the filename already exists I want them to be asked whether to overwrite.
Here's my code:
Function SaveCurrentWorkbook(wkbSource As Workbook, strNewFileName As String) As Variant
If Not bolDebug Then On Error GoTo errHandler
Dim varSaveName As Variant
SaveAsDialog:
varSaveName = Application.GetSaveAsFilename(InitialFileName:=strNewFileName, FileFilter:="Excel Files (*.xls), *.xls")
If varSaveName <> False Then
wkbSource.SaveAs Filename:=varSaveName, ConflictResolution:=True, Addtomru:=True
Set SaveCurrentWorkbook = wkbSource
Else
SaveCurrentWorkbook = False
Err.Raise 11111, , "Save Canceled"
End If
exitProc:
Exit Function
errHandler:
Select Case Err.Number
Case 1004 'Clicked "No" or "Cancel" - can't differentiate
Resume SaveAsDialog
Case esle
MsgBox "File not saved. Stopping script.", vbOKOnly, Err.Description
Resume exitProc
End select
End Function
If they click 'Yes', it overwrites it. If they click 'No', I want the SaveAs dialog box to come up so they can select a new filename, but instead I get an error. If they click 'Cancel', I want an error to occur and for the script to stop. The problem is I can't differentiate the errors triggered between 'No' and 'Cancel'.
Any suggestions how to handle this? (Please excuse any poor use of error handling - it's been a while.)
P.S. This function is called by another procedure so if the user clicks 'Cancel' at either the SaveAs dialog box or the ResolveConflict dialog, I would like the calling procedure to stop as well. I figure I can do this by checking what SaveCurrentWorkbook returns (either a Workbook object or False).
You can simply create your own "overwrite?"-question like this:
Function SaveCurrentWorkbook(wkbSource As Workbook, strNewFileName As String) As Variant
If Not bolDebug Then On Error GoTo errHandler
Dim varSaveName As Variant
SaveAsDialog:
varSaveName = Application.GetSaveAsFilename(InitialFileName:=strNewFileName, FileFilter:="Excel Files (*.xls), *.xls")
If varSaveName <> False Then
If Len(Dir(varSaveName)) Then 'checks if the file already exists
Select Case MsgBox("A file named '" & varSaveName & "' already exists at this location. Do you want to replace it?", vbYesNoCancel + vbInformation)
Case vbYes
'want to overwrite
Application.DisplayAlerts = False
wkbSource.SaveAs varSaveName, ConflictResolution:=2, Addtomru:=True
Application.DisplayAlerts = True
Set SaveCurrentWorkbook = wkbSource
Case vbNo
GoTo SaveAsDialog
Case vbCancel
SaveCurrentWorkbook = False
Err.Raise 11111, , "Save Canceled"
End Select
Else
wkbSource.SaveAs varSaveName, ConflictResolution:=True, Addtomru:=True
Set SaveCurrentWorkbook = wkbSource
End If
Else
SaveCurrentWorkbook = False
Err.Raise 11111, , "Save Canceled"
End If
exitProc:
Exit Function
errHandler:
Select Case Err.Number
Case 1004 'Clicked "No" or "Cancel" - can't differentiate
Resume SaveAsDialog
Case Else
MsgBox "File not saved. Stopping script.", vbOKOnly, Err.Description
Resume exitProc
End Select
End Function
As you have noticed, there is no difference between "No" and "Cancel" (for the application, because it will not stop the saving itself). Excel simply lies to itself saying: "I can't save here" and pops the same error for both cases... so the only real solution is to create your own msgbox :(
I would make SaveCurrentWorkbook return True or False and use Msgboxes to handle the save as strNewFileName.
Then in the script that calls SaveCurrentWorkbook you can do a simple boolean evaluation.
If SaveCurrentWorkbook(wkbSource, "C:\...\SomeFile.xls") then
'Do Something
Else
'Do Something else
End If
Function SaveCurrentWorkbook(wkbSource As Workbook, strNewFileName As String) As Boolean
Dim iResult As VbMsgBoxResult
Dim varSaveName As Variant
If Dir(strNewFileName) <> "" Then
iResult = MsgBox("Press [Yes] to overwite " & strNewFileName & " or [No] to choose a new filename.", vbInformation + vbYesNo, "Save File")
Else
iResult = MsgBox("Press [Yes] to save as " & strNewFileName & " or [No] to choose a new filename.", vbInformation + vbYesNo, "Save File")
End If
If iResult = vbYes Then
SaveCurrentWorkbook = True
Else
varSaveName = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xls), *.xls")
If CStr(varSaveName) <> "False" Then
wkbSource.SaveAs Filename:=varSaveName, ConflictResolution:=True, Addtomru:=True
SaveCurrentWorkbook = True
End If
End If
End Function
You don't need to set a reference when using SaveAs because your original is closed (without being saved )and your reference automatically updated to the new file. If you were using SaveCopyAs then your original file stays open and a copy of the current file (including any unsaved data) is made.
Notice in the test below that when we use SaveAs the refernce is updated to the SaveAs name. When we use SaveCopAs the name doesn't change because the original file is still open.

How to retain the original workbook during SaveAs

I am trying to retain the original workbook opened and close all other saved(saved with different names) files without reopening. I am doing the SaveAs through a button click. Any suggestions on this?
sub save()
Application.DisplayAlerts= False
FileName1 = Range("D4")
ActiveWorkbook.SaveCopyAs FileName:="C:\Users\felonj\Desktop\list\" & FileName1 & "-" & "Audit checklist" & ".xlsm"
MsgBox "File Saved successfully!", , "Save"
Application.DisplayAlerts = True
End sub
If I have to use your code, try something like this:
Option Explicit
Sub save()
Dim obj_wb As Object
Set obj_wb = ThisWorkbook
Application.DisplayAlerts = False
ActiveWorkbook.SaveCopyAs Filename:=ActiveWorkbook.Path & "Audit checklist" & ".xlsm"
MsgBox "File Saved successfully!", , "Save"
Debug.Print obj_wb.Name
Application.DisplayAlerts = True
Set obj_wb = Nothing
End Sub
obj_wb is the old file, accessible through this variable. Probably it is a good idea to use "ThisWorkbook" in stead of "ActiveWorkbook". Or to refer it always as a variable and not to use any of those at all.

Need to open an excel file manually in the middle of a macro

First time posting so please be kind.
From a template file, I am running a macro to create a new folder with a copy of the template file in it. I then rename it and update it. At one point, I need to manually download a file from a website and open it and then start another macro to finish the update.
I initially tried to do that from one unique macro but I got issues as the macro would keep running before the excel file had time to open.
I have now split my macro in 2. At the end of the 1st macro, I call a userform with instructions and a continue button. The idea is that I would download the file while the userform is opened and click on "continue" when the file is opened.
For some reason, the file does not open at all. It seems like either the userform or the macro stops the file from opening. However, If I run it using the debug function, It works fine...
Public strSN As String, strPart As String, strPath As String
Sub create_new()
' Create Folder if it doesn't exist
'Dim strSN As String, strPart As String, strPath As String
'strSN = SerialNumber.Value
'strPart = PartNumber.Value
'strPath = "M:\Quality\QUALITY ASSURANCE\DOC\Rental Folder\Scanned MRB's\"
' close userform
welcomeform.Hide
'set Microsoft scription runtime reference to allow creation of folder macro
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromGUID "{420B2830-E718-11CF-893D- 00A0C9054228}", 1, 0
On Error GoTo 0
If Not FolderExists(strSN) Then
'Serial Number folder doesn't exist, so create full path
FolderCreate strPath & strSN
End If
' Create new file in new folder
On Error Resume Next
ActiveWorkbook.SaveCopyAs Filename:=strPath & strSN & "\" & strPart & " " & strSN & " " & "SNR.xlsm"
If Err.Number <> 0 Then
MsgBox "Copy error: " & strPath & "TEMPLATE SNR.xlsm"
End If
On Error GoTo 0
' open new file without showing it or opening macros
Application.EnableEvents = False 'disable Events
Workbooks.Open Filename:=strPath & strSN & "\" & strPart & " " & strSN & " " & "SNR.xlsm"
Application.EnableEvents = True 'enable Events
' Modify serial number and part number in traceability summary form
Sheets("Traceability Summary Form").Activate
Sheets("Traceability Summary Form").Unprotect
Range("A7").Value = strSN
Range("C7").Value = strPart
' update file with ITP
Call Download_itp
End Sub
Sub Download_itp()
downloaditp.Show
End Sub
In the download_itp userform:
Sub continue_Click()
Call update_traceable_items
End Sub
Then the 2nd macro starts with code:
Sub update_traceable_items()
'
' Macro to update the SNR tab with the traceable items from the ITP
'
downloaditp.Hide
' copy ITP in file
Application.ActiveProtectedViewWindow.Edit
ActiveSheet.Name = "ITP"
ActiveSheet.Copy after:=Workbooks(strPart & " " & strSN & " " & "SNR.xlsm").Sheets("SNR template")
Any help would be appreciated!
Thanks
The UserForm is being displayed modally, which probably prevents you from "opening" the recently downloaded file. When UserForm is displayed modally, the user is prevented from "interacting" with any part of Excel Application that is not the UserForm itself -- so you can't select cells or worksheets, you can't open files or close files, etc.
This is the default behavior for UserForms, but fortunately there is an optional parameter for the .Show method which allows you to display the form "modelessly":
downloaditp.Show vbModeless
This allows you to interact with the Excel Application while the form is open.
Note: If the file is on a shared network location, you can probably handle this better by using a FileDialog object to allow you to "browse" to the location of the file, and open it, all within the scope of your main procedure, like:
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count <> 1 Then
MsgBox "No file selected!", vbCritical
Exit Sub
Else
Dim NewWorkbook as Workbook
Set NewWorkbook = Workbooks.Open(.SelectedItems(0))
End If
End With

excel not closing correctly - userform hanging?

I have a spreadsheet with 6 userforms, used on about 30 computers. The VBA code is password protected. Often when we close the sheet, the VBA project password box appears and excel.exe remains in task manager.
I have done a bit of testing and come up with the following:
The problem only occurs when a userform has been opened.
Nothing needs to be done with the userform to cause the popup other than to press Cancel (which calls Unload Me)
The Workbook_BeforeClose event is as follows:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
'Cancel autosave
Sheets("BOH General").Range("A102").Value = 0
AutoSaveTimer
'Application.EnableEvents = False
If Not Sheets("START").Visible = True Then Call CostingMode
Call BackItUp
'Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
And here are some other macros called by Workbook_BeforeClose:
Sub AutoSaveTimer()
If Sheets("BOH General").Range("A102").Value > 0 Then
RunWhen = Now + TimeSerial(0, Sheets("BOH General").Range("A102").Value, 0)
Application.OnTime EarliestTime:=RunWhen, Procedure:="AutoSaveIt", _
Schedule:=True
Else
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:="AutoSaveIt", _
Schedule:=False
On Error GoTo 0
End If
End Sub
Sub AutoSaveIt()
ThisWorkbook.Save
Call AutoSaveTimer
End Sub
Sub BackItUp()
'Dont run if unsaved
If Sheets("BOH General").Range("A111").Value = "" Then Exit Sub
'Prompt
If MsgBox("Do you want to backup this sheet now (recommended if you made any changes)?", vbYesNo) = vbNo Then Exit Sub
'reformat date
Dim DateStamp As String
DateStamp = Format(Now(), "yyyy-mm-dd hh-mm-ss")
On Error Resume Next
MkDir ActiveWorkbook.Path & "\" & "Backup"
On Error GoTo 0
ActiveWorkbook.SaveCopyAs (ActiveWorkbook.Path & "\" & "Backup" & "\" & ActiveWorkbook.Name & " - backup " & DateStamp & ".xlsb")
ActiveWorkbook.Save
End Sub
Is this a userform error, is the userform not closing properly? Or is it something else?
UPDATE: This error only occurs after the user clicks the excel close button (top right) clicking File>Close does not produce the error.
Interesting that I have been experiencing the same instance, it has only cropped up recently as well. Did a version of MOS change this behavior? I have users on Excel 12.0.6611.1000 and 12.0.6712.5000 that do not get this error, on 12.0.6729.5000 it always occurs.
Edit;
I resolved this issue on my end today after discovering that several users had 'Drop Box' installed. Uninstalling or turning off drop box just prior to closing the application resolved the issue.

Excel VBA Open workbook, perform actions, save as, close

This question has been edited due to lengthy comments and updates from proposed answers.
As requested here is module 13;
Sub SaveInFormat()
Application.DisplayAlerts = False
Workbooks.Application.ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\jammil\Desktop\AutoFinance\ProjectControl\Data\" & Format(Date, "yyyymm") & "DB" & ".xlsx", leFormat:=51
Application.DisplayAlerts = True
End Sub
Also there are issues with the errorhandling, I know I've gone wrong with it but I'm more interested in fixing the close function at the moment before I get into it. Here is the error handling code that needs some work
Sub test()
Dim wk As String, yr As String, fname As String, fpath As String
Dim owb As Workbook
wk = ComboBox1.Value
yr = ComboBox2.Value
fname = yr & "W" & wk
fpath = "C:\Documents and Settings\jammil\Desktop\AutoFinance\ProjectControl\Data"
owb = Application.Workbooks.Open(fpath & "\" & fname)
On Error GoTo ErrorHandler:
ErrorHandler:
If MsgBox("This File Does Not Exist!", vbRetryCancel) = vbCancel Then Exit Sub Else Call Clear
'Do Some Stuff
Call Module13.SaveInFormat
owb.Close
this is your test code plus my changing of the file path and name
After discussion posting updated answer:
Option Explicit
Sub test()
Dim wk As String, yr As String
Dim fname As String, fpath As String
Dim owb As Workbook
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
End With
wk = ComboBox1.Value
yr = ComboBox2.Value
fname = yr & "W" & wk
fpath = "C:\Documents and Settings\jammil\Desktop\AutoFinance\ProjectControl\Data"
On Error GoTo ErrorHandler
Set owb = Application.Workbooks.Open(fpath & "\" & fname)
'Do Some Stuff
With owb
.SaveAs fpath & Format(Date, "yyyymm") & "DB" & ".xlsx", 51
.Close
End With
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
End With
Exit Sub
ErrorHandler: If MsgBox("This File Does Not Exist!", vbRetryCancel) = vbCancel Then
Else: Call Clear
End Sub
Error Handling:
You could try something like this to catch a specific error:
On Error Resume Next
Set owb = Application.Workbooks.Open(fpath & "\" & fname)
If Err.Number = 1004 Then
GoTo FileNotFound
Else
End If
...
Exit Sub
FileNotFound: If MsgBox("This File Does Not Exist!", vbRetryCancel) = vbCancel Then
Else: Call Clear
I'll try and answer several different things, however my contribution may not cover all of your questions. Maybe several of us can take different chunks out of this. However, this info should be helpful for you. Here we go..
Opening A Seperate File:
ChDir "[Path here]" 'get into the right folder here
Workbooks.Open Filename:= "[Path here]" 'include the filename in this path
'copy data into current workbook or whatever you want here
ActiveWindow.Close 'closes out the file
Opening A File With Specified Date If It Exists:
I'm not sure how to search your directory to see if a file exists, but in my case I wouldn't bother to search for it, I'd just try to open it and put in some error checking so that if it doesn't exist then display this message or do xyz.
Some common error checking statements:
On Error Resume Next 'if error occurs continues on to the next line (ignores it)
ChDir "[Path here]"
Workbooks.Open Filename:= "[Path here]" 'try to open file here
Or (better option):
if one doesn't exist then bring up either a message box or dialogue
box to say "the file does not exist, would you like to create a new
one?
you would most likely want to use the GoTo ErrorHandler shown below to achieve this
On Error GoTo ErrorHandler:
ChDir "[Path here]"
Workbooks.Open Filename:= "[Path here]" 'try to open file here
ErrorHandler:
'Display error message or any code you want to run on error here
Much more info on Error handling here: http://www.cpearson.com/excel/errorhandling.htm
Also if you want to learn more or need to know more generally in VBA I would recommend Siddharth Rout's site, he has lots of tutorials and example code here:
http://www.siddharthrout.com/vb-dot-net-and-excel/
Hope this helps!
Example on how to ensure error code doesn't run EVERYtime:
if you debug through the code without the Exit Sub BEFORE the error handler you'll soon realize the error handler will be run everytime regarldess of if there is an error or not. The link below the code example shows a previous answer to this question.
Sub Macro
On Error GoTo ErrorHandler:
ChDir "[Path here]"
Workbooks.Open Filename:= "[Path here]" 'try to open file here
Exit Sub 'Code will exit BEFORE ErrorHandler if everything goes smoothly
'Otherwise, on error, ErrorHandler will be run
ErrorHandler:
'Display error message or any code you want to run on error here
End Sub
Also, look at this other question in you need more reference to how this works:
goto block not working VBA