Office 2016 VBA fails to open Internet Explorer shell window but works in Office 2013

354 Views Asked by At

I inherited this VBA script from my predecessor. It works fine for me in Excel 2013 up until recently when I was told I may need to work from home. Come to find out, the Office 2016 environment of my newly accessed VPN desktop does not like this script. I keep getting "The remote server machine is unknown or unavailable" when it reaches .ReadyState <> READYSTATE_COMPLETE.

The navigation did not fail as I can see the window where it successfully navigated to the URL and I can interact with it correctly. The strange thing is if I change the URL to "www.google.com" I get a valid ready state result.

I also need to figure out how to late bind the Shell Windows so it will work with both the v15 and v16 libraries simultaneously.

The intent of this script is to automate a process that
1. Opens an internal database at DBurl via web interface
2. Manipulates and runs a java script located on the web page
3. Close the browser window without closing any other browser windows

This could be modified for someone else's use by looking for a page element, such as a search box or specific button on a page, and interacting with it.

Edit:
Additional testing has revealed that a pause at and skipping the Do While loop and resuming at IETab1 = SWs.Count results in this script working in Office 2016. The only issue, then, is without the loop, the page isn't yet ready for the next step when the script tries to run the interaction. A wait for 5 seconds in place of the loop band-aid's this issue. Finding why the .ReadyState won't read will fix this issue.

Declare PtrSafe Function apiShowWindow Lib "user32" Alias "ShowWindow" _
            (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Sub OpenWebDB()

Dim ieApp As Object
Dim SWs As ShellWindows
Dim IETab1 As Integer
Dim JScript As String
Dim CurrentWindow As Object
Dim DBurl As String
Dim tNow As Date, tOut As Date

DBurl = "My.Database.url"

Set SWs = New ShellWindows
tNow = Now
tOut = tNow + TimeValue("00:00:15")

If ieApp Is Nothing Then
    Set ieApp = CreateObject("InternetExplorer.Application")
    With ieApp
        .Navigate DBurl
        Do While tNow < tOut And .ReadyState <> READYSTATE_COMPLETE
            DoEvents
            tNow = Now
        Loop
        IETab1 = SWs.Count
    End With
End If

If Not tNow < tOut Then GoTo DBFail

On Error GoTo DBFail
Set CurrentWindow = SWs.Item(IETab1 - 1).Document.parentWindow
JScript = "javascript: DoSomething"
Call CurrentWindow.execScript(JScript)

On Error GoTo 0
SWs.Item(IETab1 - 1).Quit

Set ieApp = Nothing
Set SWs = Nothing

Exit Sub

DBFail:
MsgBox (DBurl & vbCrLf & "took too long to connect or failed to load correctly." & vbCrLf & _
    "Please notify the Database manager if this issue continues."), vbCritical, "DB Error"
SWs.Item(IETab1 - 1).Quit

Set ieApp = Nothing
Set SWs = Nothing

End Sub
1

There are 1 best solutions below

2
Zhi Lv On

Try to remove the tNow < tOut from the Do While condition. Or, using the While statement to wait page complete:

    While IE.ReadyState <> 4
        DoEvents
    Wend

The intent of this script is to automate a process that 1. Opens an internal database at DBurl via web interface 2. Manipulates and runs a java script located on the web page 3. Close the browser window without closing any other browser windows

Besides, according to the intent of the script, I suggest you could refer the following code (it could loop through the tabs, and close specific tab according the title):

Sub TestClose()
    Dim IE As Object, Data As Object
    Dim ticket As String
    Dim my_url As String, my_title As String

    Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .Visible = True
        .Navigate "https://www.microsoft.com/en-sg/" '1st tab
        .Navigate "https://www.bing.com", CLng(2048) '2nd
        .Navigate "https://www.google.com", CLng(2048) '3rd

        While IE.ReadyState <> 4
            DoEvents
        Wend

        'wait some time to let page load
        Application.Wait (Now + TimeValue("0:00:05"))

        'get the opened windows
        Set objShell = CreateObject("Shell.Application")
        IE_count = objShell.Windows.Count

        'loop through the window and find the tab
        For x = 0 To (IE_count - 1)
            On Error Resume Next
            'get the location and title
            my_url = objShell.Windows(x).Document.Location
            my_title = objShell.Windows(x).Document.Title

            'debug to check the value
            Debug.Print x
            Debug.Print my_title

            'find the special tab based on the title.
            If my_title Like "Bing" & "*" Then
                Set IE = objShell.Windows(x)
                IE.Quit 'call the Quit method to close the tab.
                Exit For   'exit the for loop
            Else
            End If
        Next

    End With
    Set IE = Nothing
End Sub