Warning: file_get_contents(/data/phpspider/zhask/data//catemap/3/html/71.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Html 如何避免在每个循环上打开IE?_Html_Excel_Vba - Fatal编程技术网

Html 如何避免在每个循环上打开IE?

Html 如何避免在每个循环上打开IE?,html,excel,vba,Html,Excel,Vba,在过去几天我得到了很大的帮助之后,我通过在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 d

在过去几天我得到了很大的帮助之后,我通过在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


但是如果我用F8手动导航代码,它就可以工作了。我猜,因为它有更多的执行时间

好吧,如果涉及到一些javascript,但还没有准备好,并且需要更多的时间,就可以这样做。一个解决方法是尝试

Set ifrm = HTMLDoc.frames(0).frames(1).frames(0).document
直到它工作(并且有一个5秒的最大时间限制,这样你就不会陷入无休止的循环)


因此,这将尝试查找iframe,直到找到它为止,但最长为5秒。如果它更早地找到它,那么它将继续。

只需在循环外部打开IE
设置IE=New InternetExplorerMedium
,在循环内部只使用IE.navigate(以及与IE的其他交互)。我的意思是,你可以在所有导航中重复使用相同的IE,并在完成循环后关闭循环外的IE。这就是所有的魔力。你的问题在哪里?我的问题是,当我设置ifrm=HTMLDoc.frames(0).frames(1).frames(0).文档时,它说找不到对象。可能是因为IE太慢了。你只是把这一行
Set IE=New InternetExplorerMedium
放在循环之外了吗?其余的保持在循环内。@Pᴇʜ是的,只在外面。但问题是,我必须为每个循环创建一个新实例,因为我的代码访问HTMLiframe来获取一些数据。所以如果我把它放在外面。没有work@FaneDuru一般等待1秒将使其速度降低1秒。最好是动态地进行,如果速度更快,就让它继续进行,并将时间限制为5秒。请看下面我的答案。@dimitrio当然可以在
设置ifrm=HTMLDoc.frames(0).frames(1).frames(0).文档
现在的位置停止。它将替换代码中的这一行。哇。像查理一样工作。谢谢不幸的是,它现在似乎导致了一个新的错误,这是我以前用F8手动循环时没有得到的。当我到达行objID=ifrm.getElementsByName(“emxTableRowId”)(0)时,对某些条目的权限被拒绝。Value@DimitriosTop天哪,对不起,我忘记了一个
设置ifrm=Nothing
查看我的编辑。这是绝对必要的,否则你会得到错误的结果。请重试。如果您认为仍然存在计时问题,请将时间
TmrStart+5
增加到
+10
秒或其他时间。你应该有一个时间限制,不要因为一个无限循环而在一个没有响应的Excel中结束。实际上,
+5
这里是可以使用的最长时间。如果IE不可见,它不需要计算显示它所需的所有内容。所以速度更快。不需要对文档进行图形渲染。
Set ifrm = HTMLDoc.frames(0).frames(1).frames(0).document
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