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

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.

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

Related

Why do I suddenly get an error when trying to send a google search using a MSXML2.XMLHTTP object?

I'm using this script I compiled to get details about the documentaries that I watch. Based on the filename, I get a documentary name, I then compile a google search string, I search google, get google's response, open the correct link from it, and get the data. This used to work until a few days ago. Today, I tried running my script, and I get an error right at the very beginning, while calling the function that does the google search. This is the function:
Public Function getHTTP(ByVal url As String) As String
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", url, False
.send
getHTTP = StrConv(.responseBody, vbUnicode)
End With
End Function
"url" is compiled based on different criteria. Right now it is:
https://www.google.com/search?hl=en&source=hp&q=site:docuwiki.net+++"secrets+in+our+dna+"
The error triggers on the ".send" line. The error is:
Run-time error '-2147024891 (80070005)': Access denied.
If I then click on debug and try to run the script again (from the current point), I get another error:
Run-time error '2147467259 (80004005)': Unspecified error.
I don't think I made any changes to the system between the last time it worked and now. Haven't installed anything, no updates, nothing. I should mention that I'm on a fairly old laptop, using MSOffice 2007 under Windows 7.
Here's a minimal reproducible example. This causes the aforementioned error (that it wouldn't have a couple of weeks ago).
Public Function getHTTP(ByVal url As String) As String
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", url, False
Debug.Print url
.send
getHTTP = StrConv(.responseBody, vbUnicode)
End With
End Function
Sub testing123()
Dim a, URL1
URL1 = "https://www.google.com/search?hl=en&source=hp&q=site:docuwiki.net+bbc+""beautiful+minds+"""
a = lcase(getHTTP(URL1))
End Sub
Apparently, the problem was caused by not having opened Internet Explorer in a long time. When I tested my URLs, I only did so in Chrome. When I tried to paste the same URL in IE and access it, I got one of those cookie confirmation pages. After agreeing to the cookies and closing IE, I tested the script again and it worked like it used to.

How to Know an Alert Pop-Up Has Occurred

I am automating a website. I am using SeleniumBasic in Excel VBA.
I have a simple Pop-Up, or Alert, with an OK button.
I cannot access the Pop_Up by using Inspect so I have no HTML to show.
When the Pop-Up occurs, I respond with Driver.SwitchToAlert.Accept. It goes away, as desired.
I don't know how to check programmatically if the Pop-Up is present.
If I assume that the Pop-Up may have occurred and use this code on a just-in-case basis, i.e. use the code without the Pop-Up existing, the program stops without any error message.
Is there a way to check if the Pop-Up window exists before I respond?
Well, I found the answer:
I got this code from someone who got it from someone else.
Private Function AlertIsPresent() As Boolean
'Returns true if an alert is present, false otherwise
Dim T As String
On Error Resume Next
T = Driver.Title 'This raises error 26 if an alert(pop-up) is displayed
AlertIsPresent = (26 = Err.Number)
End Function
If function returns 'true', use the Driver.SwitchToAlert.Accept to close it.

How to make Toaster Notification on Excel with VBA

I would like to create/use toasters notifications on Excel. Because we already use MsgBox to notify the user that something happen.
But it make the script to stop (pause).
Have you any idea of how to do ?
On google there is "System Tray Notification" but it need a lot of code and this is a old method. Can't find if there is a new method.
For example, the plugin from SAP : "Analysis For Office" put notifications on Excel.
I looked into this once and almost gave up on it entirely until I found a rather 'cheaty' way of alerting users of info without suspending execution, that works on my users machines.
We run Windows 10 here and have SCCM installed for software distribution and updates. I've absolutely no idea if that's mandatory in Windows for updates or not, so I've no idea if this works for you.. but the following code works a treat here if you don't mind the notification resembling a Software Centre notification:
Sub Toastnote(ccmTitle, ccmText)
Shell "c:\windows\ccm\sctoastnotification.exe """ & ccmTitle & """ """ & ccmText & """ "
End Sub
You can call it with:
toastnote "title goes here","message goes here"
It creates a little pop-up that looks like this:
As I say, it's a bit of a cheat and might confuse users who regularly receive CCM notifications, but for my user-base that wasn't an issue.
Lastly, it's probably worth wrapping this in an IF statement that checks the .exe file exists - just a thought..
Using the Plugin "Analysis For Office" from SAP, you can define messages and add them to the standard SAP-AnalysisForOffice message dialog :
Dim lResult As Long
lResult= Application.Run("SAPAddMessage", "This is a new error message!", "ERROR")
The message 'This is a new error message' with severity Error is displayed in the message dialog.
It will do the same as the picture sent with my question.
Source
Details about SAPAddMessage
I had a similar requirement (mainly for debugging)
My solution was to pop up a small form with a single label control and unload it 4 seconds later. The form proeprties are set no not show modal etc.
in a VBA "Module"
Private mFrmToast As frmToast
Public Sub clearToast()
On Error Resume Next
If Not mFrmToast Is Nothing Then
mFrmToast.Hide
Unload mFrmToast
Set mFrmToast = Nothing
End If
End Sub
Public Sub showToast(message As String)
On Error GoTo er_clear_in_4
If mFrmToast Is Nothing Then
Set mFrmToast = New frmToast
End If
mFrmToast.message = message
If Not mFrmToast.Visible Then
Call mFrmToast.Show(False)
End If
er_clear_in_4:
Application.OnTime Now + TimeValue("00:00:04"), "clearToast"
End Sub
The form "code behind" module contained a sample write only property, "message".
Option Explicit
Public Property Let message(ByVal sMessage As String)
lblMessage.Caption = sMessage
End Property
The usage is simply
showToast("your message here")

Excel VBA: Method 'Wait' of object '_Application' failed

I am using same Splash Screen User Form for 3 years in my company but today it started giving Method 'Wait' of object '_Application' failed error.
I am assuming this is related to New Microsoft Share Point (previously we were using our internal share point now using cloud)
I tried to search on SO but nothing exactly same. (i.e: Method 'VBE' of object '_Application' failed)
I tried deleting the extra paranthesis but no change...
I am thinking of adding On Error statement but if my splash screen won't pop-up why would I have this code & user form? So honestly rather than On Error statement I want to have a real solution.
Application.Wait (Now + TimeValue("00:00:01"))
SplashUserForm.Label1.Caption = "Opening..."
SplashUserForm.Repaint
Application.Wait (Now + TimeValue("00:00:01"))
Unload SplashUserForm
Application.OnKey "{F7}", "showContains"
*An Error comes straight away when it comes to Application.Wait (Now + TimeValue("00:00:01"))
UPDATE
After reviewing Stax' suggestion as per his comment once I change the Application object with CreateObject("Excel.Application") this fixes the first problem which is Wait method. But then the next line OnKey method doesn't work with CreateObject("Excel.Application").
You can use Application.ScreenUpdating=False and it goes quicker.

Assigning an existing process to an object variable?

I need to assign another application as an object and control it.
Typically, I would open a new instance of the application using CreateObject(), but in this instance I need an existing instance of the object that was already opened in Windows Explorer. The object is an Internet Explorer session that, for various reasons, I can't simply navigate to using web browser controls in Office.
Is there a way to grab this application session by its window handle or something so that I can control it using the APIs that VBA offer? It's also essential that the application stays on the page that it was on and that its entire DOM structure remains intact.
Try this in a sub, it works for me
Set objShell = CreateObject("Shell.Application")
IE_count = objShell.Windows.Count
For x = 0 To (IE_count - 1)
On Error Resume Next ' sometimes more web pages are counted than are open
my_url = objShell.Windows(x).Document.Location
my_title = objShell.Windows(x).Document.Title
If my_title Like "The Title You're Looking For" & "*" Then
Set ie = objShell.Windows(x)
Exit For
Else
End If
Next
Now do stuff with this instance of ie

Resources