Office 2016 VBA无法打开Internet Explorer外壳窗口，但可以在Office 2013中工作

Question

我从上一代继承了这个VBA脚本。它在Excel 2013中对我来说很好，直到最近我被告知可能需要在家工作。来看看，我新访问的VPN桌面的Office 2016环境不喜欢这个脚本。当到达.ReadyState <> READYSTATE_COMPLETE时，我不断得到"远程服务器机器未知或不可用">

导航没有失败，因为我可以看到它成功导航到URL的窗口，并且我可以正确地与它交互。奇怪的是，如果我将URL更改为"www.google.com"，我会得到一个有效的就绪状态结果

我还需要弄清楚如何延迟绑定Shell Windows，以便它能够同时使用v15和v16库。

此脚本的目的是使
1的过程自动化。通过web界面
2在DBurl上打开内部数据库。操作并运行网页上的java脚本
3。关闭浏览器窗口而不关闭任何其他浏览器窗口

这可以通过查找页面元素(如搜索框或页面上的特定按钮(并与之交互来修改以供他人使用。

编辑：
其他测试表明，暂停并跳过Do While循环，然后在IETab1 = SWs.Count恢复，会导致此脚本在Office 2016中工作。那么，唯一的问题是没有循环，当脚本尝试运行交互时，页面还没有为下一步做好准备。等待5秒钟代替环形创可贴是这个问题。查找.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

尝试从Do While条件中删除tNow < tOut。或者，使用While语句等待页面完成：

While IE.ReadyState <> 4
DoEvents
Wend

此脚本的目的是自动化1.通过web界面在DBurl上打开内部数据库2.操作并运行位于网页上的java脚本3.关闭浏览器窗口而不关闭任何其他浏览器窗口

此外，根据脚本的意图，我建议您可以参考以下代码(它可以循环通过选项卡，并根据标题关闭特定选项卡(：

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