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
Related
i need to find a way to delete all the excel workbooks but the active one after some condition is fulfilled. I am new to VBA, so it is possible that I got here some very basic problem (but I couldn't find similar question here on SO). Here's my code:
Sub kill()
Dim wb As Workbook
Dim A As String
A = 2
If A = 1 Then
MsgBox "Everything is fine"
'The if condition is working just fine
Else
Application.DisplayAlerts = False
For Each wb In Application.Workbooks
If Not (wb Is Application.ActiveWorkbook) Then
Application.DisplayAlerts = False
If wb.Path <> vbNullString Then
wb.ChangeFileAccess vbNormal
kill (wb.FullName)
End If
ThisWorkbook.Close SaveChanges:=False
End If
Next
End If
End Sub
The if condition is working well, but VBA seems to have a difficulties with the kill command, which confuses me since the "killing" part is working perfectly when not put inside of the If Not condition.
Thank you very much for any suggestions you could provide.
Best regards,
Maritn
If you want just to close all workbooks but active one, you could use the code I paste below:
Dim wb As Workbook
For Each wb In Application.Workbooks
If wb.Name <> ActiveWorkbook.Name Then
wb.Save
wb.Close
End If
Next wb
If you want rather to close all workbooks except of the one that have this macro inside, replace ActiveWorkbook with ThisWorkbook. Other thing is to delete all files. This is obviously risky operation, so I would suggest to restrict it to the specific folder. It happened that I have one subroutine of this kind, see:
Sub DeleteFilesFromFolder()
Dim myPath
myFolder = Sheets("Main").Range("B4").Value
Set Fso = CreateObject("Scripting.FileSystemObject")
For Each Filename In fldr.Files
Filename.Delete True ' delete all files
Next
End Sub
The path of the folder to clean is the specific cell, you can put it elsewhere, as you wish. It won't delete open workbook, if you want to avoid error messages, just use On Error Resume Next.
So, my suggestion is first to close all workbooks, then delete closed.
I'm trying to open a file to access information in the third worksheet. The .FileDialog works fine and I can select a file, but I keep getting run-time error '91' because of the line Set wbR = wb.Worksheets(3) near the bottom of this section of code because wb.Worksheets(3) = <Object variable or With block variable not set>. This leads me to believe my Set wb = Workbooks.Open(myFile) does not work and returns Nothing, but after looking through how other people have opened files using .FileDialog, I can't see how mine is different and wouldn't function. Any help or advice would be much appreciated.
'Set variables
Dim wb As Workbook 'Workbook to open
Dim wbR As Worksheet 'This is the raw data on the new workbook
Dim wsL As Worksheet 'Worksheet in current file
Dim myFile As String 'File to open
Dim FilePicker As FileDialog
'Set light chain hit worksheet
Set wsL = ThisWorkbook.Worksheets(3)
'Optimizes Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve target file
Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
'Opens folder-picking window
With FilePicker
.Title = "Select a file."
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myFile = Dir(.SelectedItems(1))
End With
'If folder is not selected
NextCode:
myFile = myFile
If myFile = "" Then GoTo ResetSettings
'Set variable equal to opened workbook
Set wb = Workbooks.Open(myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
'Sets worksheet for importing
Set wbR = wb.Worksheets(3)
*the macro continues past this last line but it doesn't get to it yet because of this error
Sorry, I have to use the answer box to do this because there is code involved. But No, you're doing fine. This is how debugging works. Now that we know which lines are not working we will try to find out why. Now try to change
wsL = ThisWorkbook.Worksheets(3)
to
wsL = ThisWorkbook.Worksheets(1)
or
wsL = ThisWorkbook.Worksheets("PUTnameOFsheetHere")
to see if it sets or not. If so then we know there is some kind of problem with WorkSheets(3).
Now we'll try to find why "Set wb = Workbooks.Open(myFile)" is not working. Tunr on your macro recording. Got to "File" on the menu and select "Open." The dialog box will open. Search for your file in the dialog box and open it. Go back to your original workbook and stop recording. Find the recorded macro and you will see the exact line That Excel used to open the file. It should be something like:
Workbooks.Open Filename:="C:\Files\CNC TEST.xlsx"
Now run your script with PF8 and hover over "myFile" after it is initialized. Does it's value match the path and filename of the recorded macro file?
I already posted a closely related question last week VBScript to add code to Excel workbook which got solved by a fellow programmer. But I ran into the next problem with that task:
With the following code, I try to loop through a folder of Excel files then open them one by one and change the macro in DieseArbeitsmappe. This works fine for the first file but the second ends with this error message.
Error message
Set objFSO = CreateObject("Scripting.FileSystemObject")
sFolder = "P:\Administration\Reports\operativ\Tagesbericht\templates\START07\TestTabsiNeu\"
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = False
For Each objFile In objFSO.GetFolder(sFolder).Files
Set objWorkbook = objExcel.Workbooks.Open(sFolder & objFile.Name)
Set component = objworkbook.VBProject.VBComponents("DieseArbeitsmappe")
strCode = _
"Sub WorkBook_Open() 'just for testing" & vbCr & _
" Application.Run (""'CommonMacro.xlsm'!Workbook_Open"")" & vbCr & _
"End Sub"
component.CodeModule.AddFromString strCode
objWorkbook.SaveAs "P:\Administration\Reports\operativ\Tagesbericht\templates\START07\TestTabsiNeu\" & objFile.Name
objExcel.Quit
Set objWorkbook = Nothing
Set component = Nothing
Next
Set objFSO = Nothing
Set objExcel = Nothing
Line 10 is Set component = objworkbook.VBProject.VBComponents("DieseArbeitsmappe")
Another problem I will face soon is that sometimes the VBComponent is called ThisWorkbook. So I will have to introduce if-else based on the Error code thrown by Line 10. Or is there a better solution for this?
Thanks in advance for your help.
This isn't a perfect answer, as I am more confused than I am certain of the exact problem... However hopefully this will help.
The command objExcel.Quit is going to close the Excel application.
I'm not quite sure how the code (in the next loop) then successfully executes
Set objWorkbook = objExcel.Workbooks.Open(sFolder & objFile.Name)
when the objExcel application has been quit. However, the .Visible and .DisplayAlerts will no longer be set True/False. The latter could cause your failure in line 10.
Therefore I suggest replacing
objExcel.Quit
with
objWorkbook.Close
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
I have created an xlam (Excel 2007 Add-In) file to handle manipulation of various files. I am trying to write a procedure in that xlam file that removes some worksheets from an opened xlsm file, and saves it as an xlsx (i.e. without macros).
So far the only thing I can do reliably is to crash Excel whenever I reach the .SaveAs call. The crash comes as a Windows Dialog stating:
Microsoft Office Excel has stopped working, Windows can try to recover your information and restart the program. [Restart the program] [Debug the Program]
In the folder that I am saving to, after every crash I am left with a temp file (ex. filename: 7A275000 with size: 0) in the folder it tried to save to.
For posterity here some things I have tried, and all have resulted in the same crash:
Hard coded filename value ("C:\Users\myUserName\Desktop\temp.xlsx")
Prompted filename from User (shown in code below)
filename without path ("temp.xlsx")
filename without extension ("C:\Users\myUserName\Desktop\temp")
filename as existing filename without extension
filename as existing filename with .xlsx extension
instead of using wb.SaveAs, I used wb.Activate followed by ActiveWorkbook.SaveAs
I have tried FileFormat:=xlOpenXMLWorkbook and FileFormat:=xlWorkbookNormal
Saved to several different directories of varying length
Added an Error trapping statement around the .SaveAs call (it does not trap any errors, and crashes Excel just the same)
The last weird bit is when I try to do a manual Save-As on the file (i.e. navigating to the Save-As menu myself) after the ws.delete calls, Excel crashes the same way. If I manually delete the Worksheets myself, then do a manual Save-As, it saves just fine.
Here is the offending code:
Public Sub ConvertToStagingFile(ByRef wb As Workbook)
Dim reWS As Object, reFILE As Object
Dim ws As Worksheet
Set reWS = CreateObject("VBScript.regexp")
reWS.IgnoreCase = True: reWS.Global = False: reWS.MultiLine = False
Set reFILE = CreateObject("VBScript.regexp")
reFILE.IgnoreCase = True: reFILE.Global = False: reFILE.MultiLine = False
reWS.Pattern = "^(home|location settings|date reference|[\w\s]{1,8} (rating|inquire) data|pkl data - \w{1,8}|verbs - \w{1,8})"
reFILE.Pattern = "\.xlsm$"
For Each ws In wb.Worksheets
If (ws.Visible = xlSheetHidden) Or (ws.Visible = xlSheetVeryHidden) Then
ws.Visible = xlSheetVisible
End If
Select Case True
Case reWS.test(ws.name)
'// Do Nothing
Case Else
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End Select
Next ws
ActiveWindow.TabRatio = 0.75
If (reFILE.test(Cached.getAdhocReportFull)) Then
Dim newName As Variant
newName = Application.GetSaveAsFilename(reFILE.Replace(Cached.getAdhocReportFull, ""), "*.xlsx")
If newName = False Then Exit Sub
wb.Activate
Application.EnableEvents = False
'// CODE RELIABLY CRASHES HERE
wb.SaveAs _
FileName:=newName, _
FileFormat:=xlOpenXMLWorkbook, _
CreateBackup:=False
Application.EnableEvents = True
End If
End Sub
Any help on this issue would be greatly appreciated.
I had what seems like exactly the same issue:
Excel 2013
Macro to delete worksheet in xlsm file
Subsequent calls to .Save, or manually saving file crashes Excel (same dialog as Hari)
The issue only appeared for us when we updated from .xls to the 'new' office file format
For info, our files are not that large (only 300kB)
As our intention is to replace the sheet the following works for us: rename old worksheet, create new worksheet (same name as old worksheet), delete the old worksheet. Seems to work for us. Why does it work? No idea.