如何避免在每个循环中打开IE？

Question

经过过去几天的大力帮助，我设法通过在excel中选择一个范围并遍历该范围来完成下载xlsm文件的代码。现在，我使用了IE方法，该方法为每个条目打开一个新的IE实例。我该如何避免呢？我的范围内有50多个条目。

是否有一种方法无法打开IE，但仍会刮除objID所需的在线数据？

Sub DownloadUpdate_Reviews()

Dim i As Range
Dim Rng As Range
Dim versch As String
Dim ordner As String
Dim dlURL As String
Dim enumm As String
Dim objID As String
Dim HTMLDoc As MSHTML.HTMLDocument
Dim ie As InternetExplorerMedium
Dim ifrm As MSHTML.HTMLDocument
Dim ifrm2 As MSHTML.HTMLDocument
Dim HttpReq As Object


'Select range
On Error Resume Next
    Set Rng = Application.InputBox( _
      Title:="Select Range", _
      prompt:="Select cell range with the E-numbers to download", _
      Type:=8)
  On Error GoTo 0
  If Rng Is Nothing Then Exit Sub

  'Limit of allowed number of blank cells
  If WorksheetFunction.CountBlank(Rng) > 10 Then
  MsgBox "Too many blank cells in range.Limit is set to 10. Please dont select a whole column as range"
GoTo Toomanyblanks
End If

'Saving location
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select where to save"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath


If .Show = -1 Then
ordner = .SelectedItems(1)
End If
End With

Application.ScreenUpdating = False
Set ie = New InternetExplorerMedium

'Skip blank cells in range
For Each i In Rng
If i = "" Then
GoTo Blank_i
End If

versch = i.Offset(0, -1)


'Get the objID
enumm = i
'Set ie = New InternetExplorerMedium
ie.Visible = True
ie.navigate "https://plm.corp.int:10090/enovia/common/emxFullSearch.jsp?pageConfig=tvc:pageconfig//tvc/search/AutonomySearch.xml&tvcTable=true&showInitialResults=true&cancelLabel=Close&minRequiredChars=3&genericDelete=true&selection=multiple&txtTextSearch=" & [i] & "&targetLocation=popup"

While ie.readyState <> 4 Or ie.Busy: DoEvents: Wend


'choosing the right frame
Set HTMLDoc = ie.document
Set ifrm = HTMLDoc.frames(0).frames(1).frames(0).document
'Debug.Print HTMLDoc.frames(0).frames(1).frames(0).Name

'getting the specific object ID
objID = ifrm.getElementsByName("emxTableRowId")(0).Value
'Debug.Print objID



'start download
dlURL = "https://plm.corp.int:10090/enovia/tvc-action/downloadMultipleFiles?objectId=" & [objID] & ".xlsm"

Set HttpReq = CreateObject("Microsoft.XMLHTTP")
HttpReq.Open "GET", dlURL, False
HttpReq.send

dlURL = HttpReq.responseBody
If HttpReq.Status = 200 Then
    Set oStrm = CreateObject("ADODB.Stream")
    oStrm.Open
    oStrm.Type = 1
    oStrm.Write HttpReq.responseBody
    oStrm.SaveToFile [ordner] & "\" & [i] & "_" & [versch] & ".xlsm", 2 ' 1 = no overwrite, 2 = overwrite"
    oStrm.Close
End If


Blank_i:
Next

'quit InternetExplorer
ie.Quit
Set ie = Nothing

Toomanyblanks:
End Sub

在以下行中发生错误：找不到成员

Set ifrm = HTMLDoc.frames(0).frames(1).frames(0).document

但是如果我用F8手动浏览代码，它会起作用。我猜是因为它有更多执行时间？！

Answer 1

嗯，如果涉及到一些JavaScript并且还没有准备好，并且需要更多时间，那就可能是这样。解决方法可以尝试

Set ifrm = HTMLDoc.frames(0).frames(1).frames(0).document

直到它起作用为止（并且最长时限为5秒钟，所以您不会陷入无限循环中）。

Dim TmrStart As Single
TmrStart = Timer 'initialize timer

Set ifrm = Nothing 'absolutely necessary otherwise the old frame could stay referenced.

Do
    On Error Resume Next
    Set ifrm = HTMLDoc.frames(0).frames(1).frames(0).document
    On Error Goto 0

Loop While TmrStart + 5 > Timer AND ifrm Is Nothing

If ifrm Is Nothing Then
    Msgbox "The iframe was not found within 5 seconds. It finally failed."
End If

因此，它将尝试找到iframe，直到找到它为止，但最多5秒钟。如果它较早找到它，则继续进行。