Ignore "Do you wish to save" box on exit of excel - vba

I have a script that opens an excel file and runs a macro, then quits the file. Since the file is in read only mode, and the script makes temporary changes to the file, when the script calls myExcelWorker.Quit() excel asks if I want to save my changes and I must click 'no'. Is there any way to exit the program and skip this box?
' Create a WshShell to get the current directory
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
' Create an Excel instance
Dim myExcelWorker
Set myExcelWorker = CreateObject("Excel.Application")
myExcelWorker.Visible = True
' Tell Excel what the current working directory is
' (otherwise it can't find the files)
Dim strSaveDefaultPath
Dim strPath
strSaveDefaultPath = myExcelWorker.DefaultFilePath
strPath = WshShell.CurrentDirectory
myExcelWorker.DefaultFilePath = strPath
' Open the Workbook specified on the command-line
Dim oWorkBook
Dim strWorkerWB
strWorkerWB = strPath & "\BugHistogram_v2.xlsm"
Set oWorkBook = myExcelWorker.Workbooks.Open(strWorkerWB)
' Build the macro name with the full path to the workbook
Dim strMacroName
strMacroName = "CreateImagesButton_Click"
on error resume next
' Run the calculation macro
myExcelWorker.Run strMacroName
if err.number <> 0 Then
' Error occurred - just close it down.
End If
err.clear
on error goto 0
' oWorkBook.Save ' this is ignored because it's read only
myExcelWorker.DefaultFilePath = strSaveDefaultPath
' Clean up and shut down
Set oWorkBook = Nothing
' Don’t Quit() Excel if there are other Excel instances
' running, Quit() will
' shut those down also
if myExcelWorker.Workbooks.Count = 0 Then
myExcelWorker.Quit
End If
myExcelWorker.Quit()
Set myExcelWorker = Nothing
Set WshShell = Nothing

ActiveWorkbook.Close False (to close the workbook)
Application.Quit (to quit Excel - doesn't prompt to save changes)
From Microsoft Support's How to suppress "Save Changes" prompt when you close a workbook in Excel:
To force a workbook to close without saving any changes, type the
following code in a Visual Basic module of that workbook:
Sub Auto_Close()
ThisWorkbook.Saved = True
End Sub
Because the Saved property is set to True, Excel responds as though the workbook has already been saved and no changes have
occurred since that last save.
The DisplayAlerts property of the program can be used for the same
purpose. For example, the following macro turns DisplayAlerts off,
closes the active workbook without saving changes, and then turns
DisplayAlerts on again.
Sub CloseBook()
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
You can also use the SaveChanges argument of the Close method.
The following macro closes the workbook without saving changes:
Sub CloseBook2()
ActiveWorkbook.Close savechanges:=False
End Sub

The answer you have above is for VBA - you can address this in your VBS directly by using
oWorkBook.Close False
Set oWorkBook = Nothing
in place of
Set oWorkBook = Nothing

Related

VBScript "open all workbooks" Error Handling

My VBScript opens all "xlsm" files in a folder, runs VBA code "Slim" and closes the workbook (one-by-one). It works fine, but I struggle with error handling. If the script tries to open a workbook currently open by someone else, I end up with error popup Someone else is working in /path + wb-name/ right now. Please try again later. and the loop pauses up until OK is clicked on the warning message. Looks like it will open the workbook no problem, but ends up with an error at the end since the VBA code saves a new file and tries to delete the old one. Hence, I'll end up with a new file and non-deleted old one on top of the error message.
While clearly not the ideal solution, quitting the whole loop in this scenario would also be better than waiting for the OK to be clicked, since VBScript is automated to launch.
I'd need to build an error handling for this scenario, so that already opened file would just be skipped and the loop would continue uninterrupted. Unfortunately, DisplayAlerts = False good ol' On Error Resume Next won't do it here.
If possible in a reasonable way, I'd like to solve this through VBScript and not adjust the VBA code.
Set fso = CreateObject("Scripting.FileSystemObject")
Set xl = CreateObject("Excel.Application")
On Error Resume Next
xl.DisplayAlerts = False
For Each f In fso.GetFolder("G:\Archive").Files
If LCase(fso.GetExtensionName(f.Name)) = "xlsm" Then
Set wb = xl.Workbooks.Open(f.Path)
xl.Run "Slim"
wb.Close
End If
Next
xl.Quit
Set fso = Nothing
Set xl = Nothing
Tried different scenarios, haven't cracked it so far. Latest option was this, but didn't help (is there a different way of checking if the workbook is currently read-only)?
For Each f In fso.GetFolder("G:\Archive").Files
If LCase(fso.GetExtensionName(f.Name)) = "xlsm" Then
Set wb = xl.Workbooks.Open(f.Path)
If NOT wb.ReadOnly Then
xl.Run "Slim"
wb.Close
Else
wb.Close
End If
End If
Next
If an excel file is open, opening it again is blocked. Renaming the file is also blocked, but a failed rename does not show a message box with resume next
Try this code. It tries to rename the file first. If the rename succeeds, it renames back then runs the macro. If rename fails, it skips the file.
Set fso = CreateObject("Scripting.FileSystemObject")
Set xl = CreateObject("Excel.Application")
On Error Resume Next
xl.DisplayAlerts = False
For Each f In fso.GetFolder("D:\MikeStuff\StackOverflow\ExcelCheckOpen").Files
If LCase(fso.GetExtensionName(f.Name)) = "xlsm" Then
xpath = f.Path ' file path lost after rename
fso.MoveFile xpath, xpath & ".txt" ' will fail if file locked by excel
if fso.FileExists(xpath & ".txt") Then ' rename worked, file not locked
fso.MoveFile xpath & ".txt", xpath ' rename back
Set wb = xl.Workbooks.Open(xpath)
xl.Run "Slim"
wb.Close
End If
End If
Next
xl.Quit
Set fso = Nothing
Set xl = Nothing

Quitting Excel Workbook from Word leaves Excel open

I have a Macro in Word, that is reading data from an Excel file.
I have the following lines in my Macro to open and close the Excel file:
Excel_path = "C:\Users\....\Documents\myExcelfile.xlsx"
Dim myExcel As Object
Dim myWB As Object
Set myExcel = CreateObject("Excel.Application")
Set myWB = myExcel.Workbooks.Open(Excel_path)
With myWB.Sheets(2)
*.... Reading in data ....*
End With
myWB.Close savechanges:=False
myExcel.Quit
End Sub
Although I close both the workbook and I quit the application, I keep getting the message that my Excel file is locked for editing after succesfully running the Macro in Word. Also, if I close the Word application I keep having this..
I checked in my Excel workbook, but it doesn't show any connections.
How can I truly quit my Excel workbook?
I would Suggest you to do :
Application.Quit
For example :
myWB.Close SaveChanges:=False
With myExcel
.DisplayAlerts = False
.Quit
End With
And if after that Excel process Still exist in your process manager then use kill to kill excel process. You can found an example there.
Basicly I would do like this to be sure that Excel Is definitivly closed :
Sub Tryme()
Dim MyList As Object
Dim oServ As Object
Dim cProc As Variant
Dim oProc As Object
myWB.Close SaveChanges:=False
With myExcel
.DisplayAlerts = False
.Quit
End With
Set objList = GetObject("winmgmts:") _
.ExecQuery("select * from win32_process where name='" & process & "'")
If MyList.Count > 0 Then
Set oServ = GetObject("winmgmts:")
Set cProc = oServ.ExecQuery("Select * from Win32_Process")
For Each oProc In cProc
If oProc.Name = "EXCEL.EXE" Then
MsgBox "KILL" ' used to display a message for testing pur
oProc.Terminate()
End If
Next
End If
End Sub
Don't close the workbook, instead do:
myWB.Saved = True
myExcel.Quit
Instead of setting .Saved you can also set
myWB.DisplayAlerts = False

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.

Excel VBA - On Error Execute Code

Im using Application.FileDialog(msoFileDialogFolderPicker) to choose a folder. This is executed by using a button in userform. However before the user choose the folder a new sheet will be created. Then the open file dialog [Application.FileDialog(msoFileDialogFolderPicker)] will pop up.
Function SelectFolder(Optional msg As String) As String
Dim diaFolder As FileDialog
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Title = msg
diaFolder.Show
On Error Resume Next
SelectFolder = diaFolder.SelectedItems(1)
On Error GoTo 0
Set diaFolder = Nothing
End Function
The problem arises when user decided to cancel to choose the folder. When this happen, the newly created sheet should be deleted. I tried to use error handler but now luck.
ErrorHandler:
If SheetExists("MS") Then Application.Run "DeleteSheet.deleteSh1"
If SheetExists("MS2") Then Application.Run "DeleteSheet.deleteSh2"
If SheetExists("MT") Then Application.Run "DeleteSheet.deleteSh3"
Application.Run "HideSheets.hideSh"
Resume Next
Exit Sub
Hope you guys can give some idea on this.
why not create the sheet when you have a valid response?
That said, you could check the length of the string you are looking for - 0 means cancel, i.e.
Dim strResponse As String
strResponse = SelectFolder("test")
If Len(strResponse) = 0 Then
MsgBox "user cancelled", vbCritical
'delete sheet
End If
I imagine the above routine SelectFolder is called somehow from a sub that first creates a worksheet then calls it. You could achieve your goal like this:
Sub MyButton_Click()
Dim newWS as worksheet, folder as String
set newWS = sheets.Add
folder = SelectFolder("please select your folder")
If folder = "" Then
newWS.Delete
Else
' ... proceed with the selected folder
End If
End Sub
However, creating the Worksheet before getting the user's answer doesn't seem to me like a good approach, unless there's some strong reason.

Macro that runs a Macro that opens files and save them as value - Runtime Error 1004

I keep getting this 1004 runtime error. I have slimmed my programing down some so it’s not so Programception. I think it may have to do with using Excel 2010 to save .xls files. Not sure.
When Auto_Root.xls opens it runs Sub auto_open() which opens
Panel.xls
Panel opens and runs Sub Update() which sequentially opens 7 files
in different directories all called Auto_Update.xls
Auto_Update.xsl opens and runs Sub Flat which each open a number of
files sequentially and saves a flat copy of themselves in another
directory.
I have opened each of the 7 Auto_Update.xls files and have run them independently and they run with no errors. When I run them all from Auto_Root I get a runtime error 1004. And CurrentWB.Save is highlighted on one of the files. I even replaced CurrentWB.Save as CurrentWB.SaveAs Filename:=TargetFile, FileFormat:=xlNormal and recieved the same runtime error.
Attached is the code I have.
AutoRoot.xls!Auto Update
Sub auto_open()
Application.CutCopyMode = False
Dim PanelFilePath As String
Dim PanelFileName As String
Dim PanelLocation As String
Dim PanelWB As Workbook
PanelFilePath = "D:\umc\UMC Production Files\Automation Files\"
PanelFileName = "Panel.xls"
PanelLocation = PanelFilePath & Dir$(PanelFilePath & PanelFileName)
Set PanelWB = Workbooks.Open(Filename:=PanelLocation, UpdateLinks:=3)
PanelWB.RunAutoMacros Which:=xlAutoOpen
Application.Run "Panel.xls!Update"
PanelWB.Close
Call Shell("D:\umc\UMC Production Files\Automation Files\Auto.bat", vbNormalFocus)
Application.Quit
End Sub
Panel.xls!Update
Sub Update()
Dim RowNumber As Long
Dim AutoUpdateTargetFile As String
Dim AutoUpdateWB As Workbook
For RowNumber = 1 To (Range("AutoUpdate.File").Rows.Count - 1)
If (Range("AutoUpdate.File").Rows(RowNumber) <> "") Then
AutoUpdateTargetFile = Range("Sys.Path") & Range("Client.Path").Rows(RowNumber) & Range("AutoUpdate.Path ").Rows(RowNumber) & Range("AutoUpdate.File").Rows(RowNumber)
Set AutoUpdateWB = Workbooks.Open(Filename:=AutoUpdateTargetFile, UpdateLinks:=3)
AutoUpdateWB.RunAutoMacros Which:=xlAutoOpen
Application.Run "Auto_Update.xls!Flat"
AutoUpdateWB.Close
End If
Next RowNumber
End Sub
AutoUpdate.xls!Flat
Sub Flat()
Dim RowNumber As Long 'Long Stores Variable
Dim SheetNumber As Long
Dim TargetFile As String 'String Stores File Path
Dim BackupFile As String
Dim CurrentWB As Workbook 'Workbook Stores Workbook
For RowNumber = 1 To (Range("File").Rows.Count - 1)
'Loops through each file in the list and assigns a workbook variable.
If (Range("File").Rows(RowNumber) <> "") Then
TargetFile = Range("Sys.Path") & Range("Path").Rows(RowNumber) & Range("File").Rows(RowNumber) 'Target File Path
BackupFile = Range("Report.Path") & Range("Path").Rows(RowNumber) & Range("SubFolder") & Range("File").Rows(RowNumber) 'Backup File Path
Set CurrentWB = Workbooks.Open(Filename:=TargetFile, UpdateLinks:=3) 'Sets CurrentWB = to that long name. This becomes the name of the workbook.
CurrentWB.RunAutoMacros Which:=xlAutoOpen 'Enables Macros in Workbook
CurrentWB.SaveAs Filename:=TargetFile, FileFormat:=56
For SheetNumber = 1 To Sheets.Count 'Counts Worksheets in Workbook
Sheets(SheetNumber).Select 'Selects All Worksheets in Workbook
If (Sheets(SheetNumber).Name <> "What If") Then
Sheets(SheetNumber).Unprotect ("UMC626") 'Unprotects Workbook
Cells.Select 'Selects Data in Workbook
Range("B2").Activate
With Sheets(SheetNumber).UsedRange
.Value = .Value
End With
Sheets(SheetNumber).Protect Password:="UMC626", DrawingObjects:=True, Contents:=True, Scenarios:=True 'Protects Workbook
End If
Next SheetNumber 'Runs Through Iteration
Sheets(1).Select
Range("A1").Select 'Saves each workbook at the top of the page
CurrentWB.SaveAs Filename:=BackupFile, FileFormat:=56, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False 'Saves Workbook in Flatten File Location
CurrentWB.Close 'Closes Workbook
End If 'Ends Loop
Next RowNumber 'Selects Another Account
End Sub
What I have done so far.
Each Individual AutoUpdate file works when ran on its on.
If Application.Run"Auto_Update.xls!Flat" is removed from Panel.xls!Update it opens and closes all of the AutoUpdate.xls files with no error.
If I link Panel.xls!Update to only 3 of the 7 AutoUpdate files.... any 3. It runs with no errors.
I just can't seem to get it to run all 7 without saying Runtime Error 1004.
I found a microsoft work around code. Not sure how to implement it though.
Sub CopySheetTest()
Dim iTemp As Integer
Dim oBook As Workbook
Dim iCounter As Integer
' Create a new blank workbook:
iTemp = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set oBook = Application.Workbooks.Add
Application.SheetsInNewWorkbook = iTemp
' Add a defined name to the workbook
' that RefersTo a range:
oBook.Names.Add Name:="tempRange", _
RefersTo:="=Sheet1!$A$1"
' Save the workbook:
oBook.SaveAs "c:\test2.xls"
' Copy the sheet in a loop. Eventually,
' you get error 1004: Copy Method of
' Worksheet class failed.
For iCounter = 1 To 275
oBook.Worksheets(1).Copy After:=oBook.Worksheets(1)
'Uncomment this code for the workaround:
'Save, close, and reopen after every 100 iterations:
If iCounter Mod 100 = 0 Then
oBook.Close SaveChanges:=True
Set oBook = Nothing
Set oBook = Application.Workbooks.Open("c:\test2.xls")
End If
Next
End Sub
http://support.microsoft.com/kb/210684/en-us
Based on the document from Microsoft linked below this is a known issue.
Copying worksheet programmatically causes run-time error 1004 in Excel
I'm not sure how many sheets this loop in Flat but it appears that is the issue. Specifically the quote:
This problem can occur when you give the workbook a defined name and then copy the worksheet several times without first saving and closing the workbook
Due to the levels that you have created using separate workbooks I would suggest starting with limiting the scope of your Update subroutine. There are many designs for something like that but I might start with passing an integer argument back and fourth between Auto Open and Update. That way you can close and reopen Panel.xls multiple times and start exactly where you left off.
Its not clear from your text, but is your procedure "Flat" inside the files you are opening and if so is it being called by the auto open macro?
It sounds like you want to only be running your macro from your original workbook, and not firing the ones in the auto open macro of the workbooks you open.
If this is indeed the case, I do something similar in one of my workbooks, where I have an "upgrade" wizard that fires when the work book is opened, however because I am upgrading, the other workbook I open, also has the upgrade wizard, and so that used to fire as well. I resolved this by opening the other workbook in a hidden instance of excel, and within my auto open macro, I have a line of code that queries the visible state of the workbook, and does not fire if it is hidden. So in the below code its the "And Me.Application.visible" that controls if the wizard is run
'Check if the ODS code is populated or default xxx, if so invoke the upgrade wizard
'but only if the application is visible
If (ActiveWorkbook.Names("Trust_ODS_Code").RefersToRange.Value = "xxx" _
Or Len(ActiveWorkbook.Names("Trust_ODS_Code").RefersToRange.Value) = 0) _
And Me.Application.visible = True Then
'run the upgrade wizard
frmCSCWizardv8.Show
End If
This requires that you open your workbooks in a separate excel instance. The below code is the snippet of code that does this, hope this is enopugh for you to get the idea
Dim lRet
Dim i As Integer, j As Integer
Dim FoundSheet As Boolean
'Because the wizard opens the old DCS in a hidden instance of Excel, it is vital that we close this if
'anything goes wrong, so belt and braces, close it every time the user presses the button
'Switch off the error handling and the display alerts to avoid any error messages if the old dcs has
'never been opened and the hidden instance does not exist
Application.DisplayAlerts = False
On Error Resume Next
book.Close SaveChanges:=False
app.Quit
Set app = Nothing
Application.DisplayAlerts = True
'set error handling
On Error GoTo Err_Clr
'populate the status bar
Application.StatusBar = "Attempting to open File"
'Default method Uses Excel Open Dialog To Show the Files
lRet = Application.GetOpenFilename("Excel files (*.xls;*.xlsx;*.xlsm;*.xlsb), *.xls;*.xlsx;*.xlsm;*.xlsb")
'If the user selects cancel update the status to tell them
If lRet = False Then
Me.lstOpenDCSStatus.AddItem "No file selected"
'if the user has selected a file try to open it
Else
'This next section of code creates a new instance of excel to open the selected file with, as this allows us to
'open it in the background
OldDCS = lRet
Application.StatusBar = "Attempting to open File - " & lRet
app.visible = False 'Visible is False by default, so this isn't necessary, but makes readability better
Set book = app.Workbooks.Add(lRet)
Application.StatusBar = "Opened File - " & lRet