CreateObject randomly throws "A system shutdown has already been scheduled" error

user3205578 picture user3205578 · Jun 2, 2014 · Viewed 20.9k times · Source

I googled and SO'd, and nothing.

My job revolves around making my co-workers lives easier.

Currently, they are using very clunky spreadsheets designed 10+ years ago.

In the process of migrating their tools and reports to the local intranet using PHP, i have configured a spreadsheet that downloads that persons permissions based on their Application.Username

Then a little back and forth with the server to generate a session key, and then pop internet explorer opens up with the relevant tool they selected from a dropdown within the workbook - meaning their session and tools are then purely browser based.

All works great, however randomly, sometimes, when the sub to open the internet browser is triggered a very bizarre error message appears :-

Upon clicking Debug, the following function is shown, and you can see for yourself which line is highlighted in yellow.

I can confirm i do not have any tasks at all within my taskschedule. When i end this, and run it again, chances are it runs just fine.. it is just sometimes that this error pops up.

Please help! Thank in advance.

Answer

Blackhawk picture Blackhawk · Jun 2, 2014

With errors this seemingly-unrelated and intermittent, I usually opt for either a bit of delay, catching the error and retrying or both.

Try the following (retry without a delay):

Function gogogo(sessKey)
On Error GoTo ErrHandler
    reportId = Sheet2.Range("A" & (Sheet2.Range("B1").Value + 1)).Value
    Set objIE = CreateObject("InternetExplorer.Application")
    URL = "http://localinternetdomainhere/OnlineTools/" & reportId & "/access/" & sessKey
    With objIE
        .Visible = True
        .navigate URL
    End With
    ThisWorkbook.Saved = True
    ThisWorkbook.Close False
    Exit Function

ErrHandler:

    If Err.Number = &H800704A6 Then 'Put a breakpoint here to make sure this is the ACTUAL VBA error number and not the ActiveX one. You might need to check against the Err.LastDllError property
        Resume
    End If
    Err.Raise Err.Number, Err.Source, Err.Description,err.HelpFile, err.HelpContext 'Reraise the error otherwise

End Function