Office 2016 VBA не может открыть окно оболочки Inte rnet Explorer, но работает в Office 2013

Question

Я унаследовал этот скрипт VBA от моего предшественника. Он отлично работает для меня в Excel 2013 до недавнего времени, когда мне сказали, что мне может понадобиться работать из дома. Выясните, что среда Office 2016 моего недавно подключенного рабочего стола VPN не любит этот сценарий. Я продолжаю получать «Компьютер удаленного сервера неизвестен или недоступен» , когда он достигает .ReadyState <> READYSTATE_COMPLETE.

Навигация не удалась, так как я вижу окно, в котором она успешно перешла на URL, и могу правильно взаимодействовать с ним. Странная вещь, если я изменю URL на «www.google.com», я получу действительный результат состояния готовности. Мне также нужно выяснить, как позднее связывать Shell Windows, чтобы она работала одновременно с библиотеками v15 и v16.

Цель этого сценария - автоматизировать процесс, который 1. Открывает внутреннюю базу данных на DBurl через веб-интерфейс 2. Управляет и запускает скрипт java, расположенный на веб-странице. 3. Закройте окно браузера, не закрывая другой браузер windows Это может быть изменено для использования кем-то другим путем поиска элемента страницы, такого как поле поиска или кнопка c на странице, и взаимодействия с ним. Редактировать: Дополнительное тестирование показало, что пауза и пропуск Do While l oop и возобновление на IETab1 = SWs.Count приводят к тому, что этот сценарий работает в Office 2016. Единственная проблема - без l oop, страница не еще не готовы к следующему шагу, когда скрипт пытается запустить взаимодействие. Подождите 5 секунд вместо лейкопластыря l oop. Поиск причины, по которой .ReadyState не будет читать, решит эту проблему.

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

Answer 1

Попробуйте удалить tNow < tOut из условия «Пока». Или, используя оператор While для ожидания завершения страницы:

    While IE.ReadyState <> 4
        DoEvents
    Wend

Цель этого сценария - автоматизировать процесс, который 1. Открывает внутреннюю базу данных в DBurl через веб-интерфейс 2. Управляет и запускает сценарий java, расположенный на веб-странице 3. Закройте окно браузера, не закрывая другой браузер windows

Кроме того, в соответствии с назначением сценария, я предлагаю вам сослаться на следующее код (это может l oop через вкладки, и закрыть указанную c вкладку в соответствии с заголовком):

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