Automation Error - Catastrophic Failure EXCEL VBA - vba

I have a workbook which is throwing this error on opening. When it does and I open the VBA module, the current line is the definition of a sub. But the only option is to kill the whole Excel process.
I've got custom document properties, I've got embedded combo-box controls, I have no clue what it might be, and Excel isn't helping.
However, when I open the same file on another computer - it doesn't throw the error.
Does anyone have any experience or advice with this kind of error?
Here's the Open code, but the 'Show Next Statement' command doesn't point here when the error occurs:
````
Private Sub Workbook_Open()
Dim ans
If Range("currentstatus") Like "*Ready for Year-End Preparation*" Then
ans = MsgBox("This workbook is ready for Year-End Preparation" & vbCrLf & "Would you like to begin?", vbYesNo)
If ans = vbYes Then
Range("Phase") = "Year-End"
SheetsSet 3
End If
End If
'Exit Sub
If Range("Phase") = "Commissions" Then
If Range("currentstatus") Like "*RVP/Dept Head Approved*" Then
ans = MsgBox("Commissions have been approved for " & Range("applicablemonth") & vbCrLf & "Would you like to enter data for the new period?", vbYesNo + vbQuestion)
If ans = vbYes Then
Range("ApplicableMonth") = Format(DateAdd("m", 1, CVDate(Range("applicablemonth"))), "YYYY-MM")
Range("CurrentStatus") = "Ready for Data Entry for " & Range("ApplicableMonth")
' now reset the summary page
Prot False, "Commission Form Summary"
Range("SalesPersonComplete") = Range("Summary")
Range("RVPComplete") = ""
Range("BrMgrComplete") = ""
Prot True, "Commission Form Summary"
Sheets("Menu").Select
' MsgBox "Begin."
End If
End If
End If
End Sub

I had this message earlier today and it was due to another instance of Excel being open as a background process (the background process had previously opened the file in question, so it must have been something to do with that). Once I closed the other instance the problem disappeared.
It might be worth checking 'Task Manager' > 'Background processes' to see if that's the case.

This sounds like a Voodoo procedure, but what helps when I got this error is to edit any of the VBA code (for example in some module add a linebreak and remove it) and then save the workbook. Maybe it's some kind of caching issue in my case but I thought it might help some of you too.

Double-check your file extension. Excel spreadsheets with macros embedded need a *.xlsm extension, not *.xls.
Total 'for-dummies' answer, but I just made this mistake myself.

Related

MS Word filename from bookmarks with VBA

Assuming I have:
a word template including macro: custom_template.dotm;
two bookmarks in this template: 'first_name" and "last_name".
I would like that on "Save" event, in the dialog box, the application proposes to user, instead of "document1", and only if relative bookmarks exist, the filename "Document of first_name second_name.docx".
Can anybody explain me how to achieve this with VBA?
Thanks.
=== UPDATE ===
Now I've this code, working well when I execute it.
I would like it runs automatically when user clicks on "save document".
Sub Demo()
Dim sFlNm As String
With ActiveDocument
sFlNm = "Document of " & .Bookmarks("first_name").Range.Text & " " & .Bookmarks("last_name").Range.Text
End With
With Dialogs(wdDialogFileSaveAs)
.Name = sFlNm
.Show
End With
End Sub
For a macro to run at the client's end, you would have to send a macro-enabled template or document. Many people who are running anti-virus software will get a warning of a possible Word virus. Then the user will have to manually enable the macros. Are they going to bother?
Making it run automatically with a Save command may have unintended consequences. You'll have to check whether the bookmarks have actually been filled, and using the Save command while you're revising the document can save it with a new file name. But you asked, so here's how: rename the macro as FileSave. Then when you choose Ctrl + S or File>Save in Word, the dialog will automatically pop up:
Sub FileSave()
Dim sFlNm As String
With ActiveDocument
sFlNm = "Document of " & .Bookmarks("first_name").Range.Text & " " & .Bookmarks("last_name").Range.Text
End With
With Dialogs(wdDialogFileSaveAs)
.Name = sFlNm
.Show
End With
End Sub
In Word, to create a macro that runs automatically when you choose a Word command, follow these steps:
Choose Developer>Macros.
Change the Macros in dropdown to Word commands.
Choose the command name you want to re-purpose.
Change the Macros in dropdown back to the macro-enabled document or template that you're developing.
Click on the Create button. A new macro is created in the VBE with the correct command name. Fill in the macro with whatever you want the macro to do.

Can you interrupt the vba code to make a sheet selection?

I will try to be as clear as possible in the description, so here goes nothing:
I have created a code in which the user selects his excel file and then the macro copies the Sheet from that file into my macro Workbook.
MyFile = Application.GetOpenFilename()
Workbooks.Open (MyFile)
ActiveSheet.Copy After:=wbook.Sheets(1)
ActiveSheet.Name = "Selected file"
Workbooks.Open (MyFile)
ActiveWorkbook.Close SaveChanges:=False
This is working, but what I realized is, that there might be cases where the selected file has multiple Sheets.
Is there a way to write the macro in which if my selected file has 1 sheet it runs the above code and if it has more than one sheet to let me select the sheet I want and then run the rest of the code?
Edit:
I thought of another way to handle this — perhaps closer to what you were looking for . . .
It's just an expansion of the basic pause routine that I use occasionally.
This is my "regular" Pause routine (using the Timer function):
Sub Pause(seconds As Single)
Dim startTime As Single
startTime = Timer 'get current timer count
Do
DoEvents 'let Windows "catch up"
Loop Until Timer > startTime + seconds 'repeat until time's up
End Sub
...so, it gave me an idea.
Honestly, I was a little surprised to discover that this works, since it's basically running two sections of code simultaneously.
Code for WaitForUserActivity :
Here's the code I used in the demo above:
Option Explicit
Public isPaused As Boolean
Sub WaitForUserActivity() 'THE 'RUN DEMO' BUTTON runs this sub.
Dim origSheet As String
isPaused = True 'flag "pause mode" as "on"
origSheet = ActiveSheet.Name 'remember current worksheet name
MsgBox "This will 'pause' code execution until you" & vbLf & _
"click the 'Continue' button, or select a different a worksheet."
Application.StatusBar = "PAUSED: Click ""Continue"", or select a worksheet."
Do 'wait for button click or ws change
DoEvents 'yield execution so that the OS can process other events
Loop Until (Not isPaused) Or (ActiveSheet.Name <> origSheet)
If isPaused Then 'the active worksheet was changed
MsgBox "Worksheet '" & ActiveSheet.Name & "' was selected." _
& vbLf & vbLf & "Now the program can continue..."
Else 'the button was clicked
MsgBox "The 'Continue' button was clicked." _
& vbLf & vbLf & "Now the program can continue..."
End If
Application.StatusBar = "Ready"
End Sub
Sub btnContinue() 'THE 'CONTINUE' BUTTON runs this sub.
isPaused = False 'flag "pause mode" as "off"
End Sub
To run the demo:
place the above code in a regular module
make sure the workbook has at least two worksheets
create two command buttons:
one for the "Run Demo" button, assign macro: WaitForUserActivity
one for the "Continue" button, assign macro: btnContinue
click the "Run Demo" button
The key command in the code is the DoEvents Function, which "yields execution so that the operating system can process other events."
DoEvents passes control to the operating system. Control is returned after the operating system has finished processing the events in its queue and all keys in the SendKeys queue have been sent.
DoEvents is most useful for simple things like allowing a user to cancel a process after it has started, for example a search for a file. For long-running processes, yielding the processor is better accomplished by using a Timer or delegating the task to an ActiveX EXE component - and the operating system takes care of multitasking and time slicing.
Any time you temporarily yield the processor within an event procedure, make sure the procedure is not executed again from a different part of your code before the first call returns; this could cause unpredictable results.
Further details (and warnings) at the source.
Original Answer:
Some suggested solutions:
Instead of "stopping" the code you could prompt the user to specify which worksheet.
The easiest way would be with an InputBox where the user would enter an ID number or otherwise identify the worksheet.
More complicated but more robust and professional-looking would be a custom dialog box with the help of a userform. There are several examples and tutorials online such as this one.
You could "pause" execution to give the user a set amount of time to select a worksheet, with a simple timer loop, ad you could even check the worksheet name to see if the user picked a new one, something like this:
Dim startTime As Single, shtName As String
If ThisWorkbook.Worksheets.Count = 1 Then
MsgBox "There is only one worksheet in this workbook."
Else
shtName = ActiveSheet.Name 'get name of active sheet
MsgBox "You have 5 seconds to select a worksheet after clicking OK.", _
vbOKOnly + vbInformation, "Select a worksheet... fast!"
startTime = Timer
Do
DoEvents
Loop Until Timer > startTime + 5
'check if user picked a new worksheet
If ActiveSheet.Name = shtName Then
MsgBox "You didn't select a new worksheet!"
Else
MsgBox "Thanks for selecting a new worksheet!"
End If
End If
It's a little hoakey but could work, especially if proper checks to make sure you've got the correct worksheet now.
I suppose you could create an worksheet event procedure that would run when a worksheet is activated, and checked a global variable to see if your "import procedure" was running, and if so, resume your code... but that would be messy and confusing and would require the code to exist in the workbook you're "importing".
Or, better than any of those would be to programmatically/logically determine which worksheet you need based on the contents of the worksheet. Is there a title? A certain date? Maybe the newest worksheet? Something in a certain cell? There must be something that differentiates it from the others.
Hopefully this gives you some ideas towards a non-linear solution. 😉
As in whole, I would recommend ashleedawg's solution, but if you
insisted on maintaining your code structure, your code could look
something like this:
You can distinguish between amount of Sheets a Workbook has using .Count property of the Sheets object (or Worksheets if you do not want to include Charts) and use InputBox to check for the sheet you want to look for.
MyFile = Application.GetOpenFilename()
Workbooks.Open (MyFile)
If ThisWorkbook.Sheets.Count = 1 Then
ThisWorkbook.ActiveSheet.Copy After:=wbook.Sheets(1)
ThisWorkbook.ActiveSheet.Name = "Selected File"
Else
Dim checkfor As String
checkfor = InputBox("What Sheet should I execute the code for?")
Dim i As Integer
For i = 0 To ThisWorkbook.Sheets.Count
If Trim(LCase(checkfor)) = Trim(LCase(Sheets(i).Name))) Then
ThisWorkbook.Sheets(i).Copy After := wbook.Sheets(1)
ThisWorkbook.Sheets(i).Name = "Selected file"
End If
Next i
End If
Workbooks.Open (MyFile)
ActiveWorkbook.Close SaveChanges:=False
Might need some further tweaking, because I was unsure what exactly you wanted to achieve.

Excel Macro VB Run-time error: Automation Error [duplicate]

I know I've seen references to this issue before, but I have tried several of the suggestions and I am still getting the error. I have a workbook that assembles data from another book and generates a report. I then want to make a new workbook, copy the report information into the new book, save the new book and close it, and then move on to the next report. It should do this around 10 times. In the part of my code where I am copying and pasting the sheets, I am getting an error
Error -2147417848 Automation error The object invoked has
disconnected from its clients
I have checked other postings about this error, and tried the suggested solutions without any results. the interesting thing is that sometimes it will make it through 5 cycles of code before breaking, sometimes only 2. The only consistency is that it always breaks in the same place
fromBook.Sheets("Report").Copy Before:=newBook.Sheets("Sheet1")
I have option Explicit at the top of the module, and I have checked to make sure that there are not any globals inside of the sub it is breaking in. That being said, It's entirely possible I have overlooked something. I also put a "timer" in at one point to make sure that the excel sheets were not walking over each other.
I could really use the help!
Here is my sub's code:
Sub CreateAndSave(ByRef Reg As Integer, ByVal j As Integer)
Dim fromBook As Workbook
Dim fromSheet As Worksheet
Dim newBook As Workbook
Dim fileExists As Boolean
Dim i As Integer
Dim Holder As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set fromBook = Application.Workbooks("Region_Audit_Report")
Set newBook = Workbooks.Add
With newBook
.SaveAs Filename:="G:\DataTeam\ExcelDev\Audit Report\Region Workbooks\Region" & Reg & " " & Month(Date) & "-" & Day(Date) & "-" & Year(Date) & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook
End With
Set newBook = Application.Workbooks("Region" & Reg & " " & Month(Date) & "-" & Day(Date) & "-" & Year(Date) & ".xlsx")
fromBook.Sheets("Report").Copy Before:=newBook.Sheets("Sheet1")
fromBook.Sheets("MonthData").Copy After:=newBook.Sheets("Report")
newBook.Sheets("MonthData").Range("A1") = "Month"
newBook.Sheets("MonthData").Range("B1") = "Store#"
newBook.Sheets("MonthData").Range("C1") = "District"
newBook.Sheets("MonthData").Range("D1") = "Region"
newBook.Sheets("MonthData").Range("E1") = "Due Date"
newBook.Sheets("MonthData").Range("F1") = "Comp Date"
newBook.Sheets("MonthData").Range("G1") = "# of Errors"
newBook.Sheets("MonthData").Range("H1") = "Late?"
newBook.Sheets("MonthData").Range("I1") = "Complete?"
newBook.Sheets("MonthData").Range("A1:I1").Interior.ColorIndex = 43
newBook.Save
newBook.Close
Application.DisplayAlerts = True
End Sub
I have had this problem on multiple projects converting Excel 2000 to 2010. Here is what I found which seems to be working. I made two changes, but not sure which caused the success:
1) I changed how I closed and saved the file (from close & save = true to save as the same file name and close the file:
...
Dim oFile As Object ' File being processed
...
[Where the error happens - where aArray(i) is just the name of an Excel.xlsb file]
Set oFile = GetObject(aArray(i))
...
'oFile.Close SaveChanges:=True - OLD CODE WHICH ERROR'D
'New Code
oFile.SaveAs Filename:=oFile.Name
oFile.Close SaveChanges:=False
2) I went back and looked for all of the .range in the code and made sure it was the full construct..
Application.Workbooks("workbook name").Worksheets("worksheet name").Range("G19").Value
or (not 100% sure if this is correct syntax, but this is the 'effort' i made)
ActiveSheet.Range("A1").Select
I have just met this problem today: I migrated my Excel project from Office 2007 to 2010. At a certain point, when my macro tried to Insert a new line (e.g. Range("5:5").Insert ), the same error message came. It happens only when previously another sheet has been edited (my macro switches to another sheet).
Thanks to Google, and your discussion, I found the following solution (based on the answer given by "red" at answered Jul 30 '13 at 0:27): after switching to the sheet a Cell has to be edited before inserting a new row. I have added the following code:
'=== Excel bugfix workaround - 2014.08.17
Range("B1").Activate
vCellValue = Range("B1").Value
Range("B1").ClearContents
Range("B1").Value = vCellValue
"B1" can be replaced by any cell on the sheet.
You must have used the object, released it ("disconnect"), and used it again. Release object only after you're finished with it, or when calling Form_Closing.
I had this same problem in a large Excel 2000 spreadsheet with hundreds of lines of code. My solution was to make the Worksheet active at the beginning of the Class. I.E. ThisWorkbook.Worksheets("WorkSheetName").Activate
This was finally discovered when I noticed that if "WorkSheetName" was active when starting the operation (the code) the error didn't occur. Drove me crazy for quite awhile.
Couple of things to try...
Comment out the second "Set NewBook" line of code...
You already have an object reference to the workbook.
Do your SaveAs after copying the sheets.
The error in the below line of code (as mentioned by the requestor-William) is due to the following reason:
fromBook.Sheets("Report").Copy Before:=newBook.Sheets("Sheet1")
The destination sheet you are trying to copy to is closed. (Here newbook.Sheets("Sheet1")).
Add the below statement just before copying to destination.
Application.Workbooks.Open ("YOUR SHEET NAME")
This will solve the problem!!

Run Macro after Submitting Response in NO else Timer Complete

I come again with new query, I have made the Macro and assigned it on Workbook.open, now I want little bit changed, I want to prompt message BOX which have contains Do You want to Stop Macro ? Option YES and NO, If I clicked on Yes with in 10 seconds of workbook Open, I want to stay on same excel without executing the Macro; otherwise, run the macro if I clicked NO or if 10 seconds is completed.
VBA has a MsgBox function, but you cannot let that one time out like you want.
To get a prompt with time-out functionality, you could use the Popup method of the WScript.Shell object. You can create the Shell object with a CreateObject call, and see the MSDN documentation for the Popup method for more details on how to use it.
#Dharmendra Maybe you can try this code:
Private Sub Workbook_Open()
wbClose
End Sub
Sub wbClose()
Dim time As Integer, prompt As String
time = 10 'this is in seconds format
prompt = "This Workbook will close in " & time & " seconds." & _
vbLf & "Press OK if you want some changes to this Workbook."
With CreateObject("WScript.Shell")
Select Case .Popup(prompt, time, "Message", 0)
Case 1
Exit Sub
End Select
End With
ThisWorkbook.Close True
End Sub
Just do some revisions if you like. Thanks!

How do I resolve a false "spreadsheet locked for editing" issue?

Using the Office 2010 suite, I have a PowerPoint presentation where all the charts are linked to an Excel workbook. In order to move the presentation and/or workbook to another directory, all the links must be updated to point to the new workbook location. To do so, I've written the following code which resides in a standard code module in PowerPoint:
Private Sub RedirectLinks()
Dim Source As String
Dim Dest As String
Dim Action As Integer
If InStr(1, ActivePresentation.Path, "Dev\") > 1 Then
Action = MsgBox("Changing pointers to PRODUCTION", vbOKCancel)
Source = "Dev\"
Dest = vbNull
Else
Action = MsgBox("Changing pointers to DEVELOPMENT", vbOKCancel)
Source = "Templates\"
Dest = "Dev\Templates\"
End If
If Action = vbOK Then
Dim SL As Slide
Dim SH As Shape
Dim Top As Double
Dim Left As Double
Dim Width As Double
Dim Height As Double
For Each SL In ActivePresentation.Slides
SL.Select
For Each SH In SL.Shapes
SH.Select
If SH.Type = msoLinkedOLEObject Then 'when we find a linked one
Top = SH.Top
Left = SH.Left
Width = SH.Width
Height = SH.Height
SH.LinkFormat.SourceFullName = Replace(SH.LinkFormat.SourceFullName, Source, Dest)
SH.Top = Top
SH.Left = Left
SH.Height = Height
SH.Width = Width
End If
Next
Next
End If
If InStr(1, Dest, "dev") > 0 Then
Action = MsgBox("About to OVER WRITE the Dev copy with this one." & vbCrLf & "Click 'Cancel' to prevent this and save manually", vbOKCancel, "OVER WRITE WARNING!!")
Else
Action = MsgBox("About to OVER WRITE the PRODUCTION copy with this one." & vbCrLf & "Click 'Cancel' to prevent this and save manually", vbOKCancel, "OVER WRITE WARNING!!")
End If
If Action = vbOK Then
ActivePresentation.SaveAs Replace(ActivePresentation.Path, Source, Dest) & ActivePresentation.Name
End If
End Sub
The code executes just fine, however, I frequently get this message box popping up from Excel when it is executing the SH.LinkFormat.SourceFullName = Replace(SH.LinkFormat.SourceFullName, Source, Dest) line.
Items of note:
The workbook in question is actually closed - I know that it's not open by anyone else (I'm the only one who usually uses it, and the other person who's in there isn't in the office this morning).
It claims the file is locked by 'another user' which is actually me. I can often get this warning by closing the workbook, then immediately reopening it. I don't know if it's a network latency issue (file resides on a server, not locally), or what, but after a few moments of using the workbook, I'll get the workbook is now available for read-write message.
I don't get this warning every time it tries to execute the line that sets the .SourceFullName. Sometimes I'll get it most times, sometimes I won't get it at all, sometimes I'll get it on occasion.
Despite my thoughts of network lag, it doesn't matter how quickly or slowly I debug through the code, I'll get this message at random times.
Flagging either new or old workbooks as Read-only at the OS level does not seem to improve the situation.
However, flagging both seems to get me 2 warnings for each replacement line execution.
Does anyone have any suggestions on how to resolve this?
I've run into odd behaviors when code in PPT opens a PPTM and my Macro security settings are anything tighter than "Open any fool thing". Try dialing your macros security in PPT and Excel as low as they'll go, just as a test, and see if that eliminates the problem.
If anyone knows of a way to set the security options on the fly and reset them after, that'd be even better. It might be possible to do that via the registry prior to doing anything that'd invoke XL.