时间戳

首页 > 解决方案 > 如何避免在每个循环上打开 IE？

html - 如何避免在每个循环上打开 IE？

问题描述

在过去几天我在这里得到了很大的帮助之后，我设法通过在 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 手动导航代码，它就可以工作。我猜，因为它有更多的执行时间？！

标签： htmlexcelvba

解决方案

好吧，如果涉及一些 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 秒。如果它更早地找到它，那么它会继续。

推荐阅读