I have a VBA program that pulls data from a network location, processes the data, and then saves it as a single CSV file. This loop will create over a 1000 separate CSV files.
The error that I get is that seemingly at random, the saving dialog box will just get stuck. It's like it's saving the file, but never completes, and will sit there indefinitely. If I hit cancel, the macro just proceeds. (I blacked out the file name)
My code for this is:
Application.ScreenUpdating = False
counter = 2
Do Until ThisWorkbook.Sheets("Production_Data").Cells(Counter, 5).Value = ""
'''' Main operations go here ''''
'Save workbook to new file
Application.DisplayAlerts = False
'move worksheet to new workbook
Set newbook = Workbooks.Add(1) 'create new workbook object with only 1 sheet
newbook.Sheets(1).Name = "toDelete" 'name the worksheet
ws.Activate 'activate the temporary worksheet to be moved
Sheets(tempSheetName).Move Before:=newbook.Sheets(1)
newbook.Sheets("toDelete").Delete 'remove the blank sheet created in new workbook
'save as CSV file
fname = destPath & "/" & tempSheetName & ".csv"
newbook.SaveAs FileName:=fname, FileFormat:=xlCSV
newbook.Close
Application.DisplayAlerts = True
counter = counter + 1
loop
Application.ScreenUpdating = True
Is there any way to automatically exit this "frozen" dialog box and continue the macro? Is there something wrong with my code? Ideally this could be avoided all together.
The only other idea I've had is that my excel book with the macro is on a network drive, and maybe somehow that gets it to freeze up somehow?
edit
I tried adding set newbook = Nothing after closing it, but it still remains open in the VBA Project manager.
Related
I am writing some VBA code within an MS Projects file, which will run every time the user saves the file.
The code will export the file to excel, and then save the excel as a csv file.
Since this will happen each time the Project is saved, most of the time a file of the same name will already exist, and therefore the pop will appear asking the user if they wish to replace the file.
I would like the process to supress this pop-up and automatically replace the file.
The following is an extract from my macro, which supresses the pop-up for the excel part of the code, but not for the csv - I guess because that's not part of the 'application'.
Application.DisplayAlerts = False
Newfn = "filepath\filename"
FileSaveAs Name:=Newfn & ".xlsx", FormatID:="MSProject.ACE", map:="Map Name"
'export to csv
Dim objXL As Object
Dim objWB As Object
Dim objWS As Object
Set objXL = CreateObject("Excel.Application")
Set objWB = objXL.workbooks.Open(Newfn & ".xlsx")
Set objWS = objWB.worksheets(1)
objWS.SaveAs Newfn & ".csv", xlCSV
objWB.Close
Application.DisplayAlerts = True
Is there something else I can use to prevent the pop up for the csv conflict?
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
I appreciate there are lots of entries like save individual excel sheets as csv
and Export each sheet to a separate csv file - But I want to save a single worksheet in a workbook.
My code in my xlsm file has a params and data sheet. I create a worksheet copy of the data with pasted values and then want to save it as csv. Currently my whole workbook changes name and becomes a csv.
How do I "save as csv" a single sheet in an Excel workbook?
Is there a Worksheet.SaveAs or do I have to move my data sheet to another workbook and save it that way?
CODE SAMPLE
' [Sample so some DIMs and parameters passed in left out]
Dim s1 as Worksheet
Dim s2 as Worksheet
Set s1 = ThisWorkbook.Sheets(strSourceSheet)
' copy across
s1.Range(s1.Cells(1, 1), s1.Cells(lastrow, lastcol)).Copy
' Create new empty worksheet for holding values
Set s2 = Worksheets.Add
s2.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
' save sheet
s2.Activate
strFullname = strPath & strFilename
' >>> BIT THAT NEEDS FIXIN'
s2.SaveAs Filename:=strFullname, _
FileFormat:=xlCSV, CreateBackup:=True
' Can I do Worksheets.SaveAs?
Using Windows 10 and Office 365
This code works fine for me.
Sub test()
Application.DisplayAlerts = False
ThisWorkbook.Sheets(strSourceSheet).Copy
ActiveWorkbook.SaveAs Filename:=strFullname, FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
It's making a copy of the entire strSourceSheet sheet, which opens a new workbook, which we can then save as a .csv file, then it closes the newly saved .csv file, not messing up file name on your original file.
This is fairly generic
Sub WriteCSVs()
Dim mySheet As Worksheet
Dim myPath As String
'Application.DisplayAlerts = False
For Each mySheet In ActiveWorkbook.Worksheets
myPath = "\\myserver\myfolder\"
ActiveWorkbook.Sheets(mySheet.Index).Copy
ActiveWorkbook.SaveAs Filename:=myPath & mySheet.Name, FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.Close
Next mySheet
'Application.DisplayAlerts = True
End Sub
You just need to save the workbook as a CSV file.
Excel will pop up a dialog warning that you are saving to a single sheet, but you can suppress the warning with Application.DisplayAlerts = False.
Don't forget to put it back to true though.
Coming to this question several years later, I have found a method that works much better for myself. This is because the worksheet(s) I'm trying to save are large and full of calculations, and they take an inconvenient amount of time to copy to a new sheet.
In order to speed up the process, it saves the current worksheet and then simply reopens it, closing the unwanted .csv window:
Sub SaveThisSheetInParticular()
Dim path As String
path = ThisWorkbook.FullName
Application.DisplayAlerts = False
Worksheets("<Sheet Name>").SaveAs Filename:=ThisWorkbook.path & "\<File Name>", FileFormat:=xlCSV
Application.Workbooks.Open (path)
Application.DisplayAlerts = True
Workbooks("<File Name>.csv").Close
End Sub
Here the Sheet and csv filename are hardcoded, since nobody but the macro creator (me) should be messing with them. However, it could just as easily be changed to store and use the Active Sheet name in order to export the current sheet whenever the macro is called.
Note that you can do this with multiple sheets, you simply have to use the last filename in the close statement:
Worksheets("<Sheet 1>").SaveAs Filename:=ThisWorkbook.path & "\<File 1>", FileFormat:=xlCSV
Worksheets("<Sheet 2>").SaveAs Filename:=ThisWorkbook.path & "\<File 2>", FileFormat:=xlCSV
[...]
Workbooks("<File 2>.csv").Close
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
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.