问题描述
我收到错误
以下是我收到此错误的代码。
Below is code in which I am getting this error.
Sub reconwebscrap() ' ' reconwebscrap Macro ' ' Keyboard Shortcut: Ctrl+Shift+R
Dim requestsearchrange As Range
Dim cell1 As Range
Dim cell2 As Range
Dim entire As Range
Dim IE As Object
Dim revocdate As String
Dim i As Integer
Dim tags As Object
Dim tagx As Object
Dim tags2 As Object
Dim tagsx As Object
Application.DisplayStatusBar = True
i = 0
With ActiveWorkbook.Sheets(2)
Set requestsearchrange = .Range(.Range("B2"), .Range("B2").End(xlDown))
End With
ActiveWorkbook.Worksheets.Add
With ActiveWorkbook.Sheets(3)
Set entire = .Range(.Range("A1"), .Range("A65536").End(xlUp))
End With
the_start:
Set IE = New InternetExplorerMedium
'Set IE = CreateObject("InternetExplorer.Application")
'-----------------------------------------------------------------------------------------------------------------
'These attributes decide the position of internet explorer window.
'-----------------------------------------------------------------------------------------------------------------
IE.Top = 0
IE.Left = 0
IE.Width = 800
IE.Height = 600
'-----------------------------------------------------------------------------------------------------------------
'Disable the viewing of Internet Explorer window.
'-----------------------------------------------------------------------------------------------------------------
IE.Visible = True
'-----------------------------------------------------------------------------------------------------------------
'Navigate to the website.
'-----------------------------------------------------------------------------------------------------------------
IE.Navigate ("https://ibid.abc.com/RMT/MyDashboard")
'-----------------------------------------------------------------------------------------------------------------
'Let the website load completely.
'Error handling in case the website is not available.
'-----------------------------------------------------------------------------------------------------------------
Do Until Not IE.Busy
DoEvents
Application.StatusBar = " Running"
Loop
'Do
'DoEvents
'If Err.Number <> 0 Then
'IE.Quit
'Set IE = Nothing
'GoTo the_start:
'End If
'Loop Until IE.readystate = 4
MsgBox "webpage has loaded"
revocdate = InputBox("enter the last revocation date")
Set tags = IE.document.getElementsByTagName("img")
'Set tags2 = IE.document.getElementById("dashboardSelect")
For Each cell1 In requestsearchrange
IE.document.getElementById("dashboardSelect").Value = "recipientSid"
IE.document.getElementById("quickSearchCriteriaVar").Value = cell1.Value
For Each tagx In tags
If tagx.alt = "Search Request" Then
tagx.Click
End If
Next tagx
Do Until Not IE.Busy
DoEvents
Loop
i = i + 1
Application.StatusBar = i & " Running"
Next cell1
Application.StatusBar = ""
End Sub
我收到此错误
For Each tagx In tags
If tagx.alt = "Search Request" Then
tagx.Click
End If
Next tagx
在此代码中,我尝试在搜索框中输入一个数字,然后单击按钮。然后等待它加载,然后输入下一个数字。但它只是在excel表中的第一个单元格中进行。之后我收到了这个错误。
In this code I am trying to enter a number in the search box and then click on the button. Then wait for it to load and then enter the next number. But it is doing it for only first cell in excel sheet. After that I am getting this error.
推荐答案
我认为可能的原因如下:
I think the probably reason is the following:
在代码的某个时刻,您将获得包含 img
标记名称的所有元素的集合。
At some point of your code you obtain the collection containing all elements with img
tag name.
稍后代码进入循环。在此循环的每次迭代中,都会单击此标记之一:
Later on the code goes into a loop. In every iteration of this loop one of this tag is clicked:
tagx.Click
我想这会触发一些JS脚本,并在HTML结构中进行一些更改。这导致之前获得的集合不再可用,应该从头开始。
I suppose this fires some JS script and some changes are made in the HTML structure. This causes the collection obtained before is not longer usable and it should be obtained from scratch.
所以如果你移动这部分代码:
So if you move this part of code:
Set tags = IE.document.getElementsByTagName("img")
进入这个循环,它应该可以工作。
into this loop, it should work.
这是你修改的代码:
Sub reconwebscrap() ' ' reconwebscrap Macro ' ' Keyboard Shortcut: Ctrl+Shift+R
Dim requestsearchrange As Range
Dim cell1 As Range
Dim cell2 As Range
Dim entire As Range
Dim IE As Object
Dim revocdate As String
Dim i As Integer
Dim tags As Object
Dim tagx As Object
Dim tags2 As Object
Dim tagsx As Object
Application.DisplayStatusBar = True
i = 0
With ActiveWorkbook.Sheets(2)
Set requestsearchrange = .Range(.Range("B2"), .Range("B2").End(xlDown))
End With
ActiveWorkbook.Worksheets.Add
With ActiveWorkbook.Sheets(3)
Set entire = .Range(.Range("A1"), .Range("A65536").End(xlUp))
End With
the_start:
Set IE = New InternetExplorerMedium
'Set IE = CreateObject("InternetExplorer.Application")
'-----------------------------------------------------------------------------------------------------------------
'These attributes decide the position of internet explorer window.
'-----------------------------------------------------------------------------------------------------------------
IE.Top = 0
IE.Left = 0
IE.Width = 800
IE.Height = 600
'-----------------------------------------------------------------------------------------------------------------
'Disable the viewing of Internet Explorer window.
'-----------------------------------------------------------------------------------------------------------------
IE.Visible = True
'-----------------------------------------------------------------------------------------------------------------
'Navigate to the website.
'-----------------------------------------------------------------------------------------------------------------
IE.Navigate ("https://ibid.abc.com/RMT/MyDashboard")
'-----------------------------------------------------------------------------------------------------------------
'Let the website load completely.
'Error handling in case the website is not available.
'-----------------------------------------------------------------------------------------------------------------
Do Until Not IE.Busy
DoEvents
Application.StatusBar = " Running"
Loop
'Do
'DoEvents
'If Err.Number <> 0 Then
'IE.Quit
'Set IE = Nothing
'GoTo the_start:
'End If
'Loop Until IE.readystate = 4
MsgBox "webpage has loaded"
revocdate = InputBox("enter the last revocation date")
'Set tags2 = IE.document.getElementById("dashboardSelect")
For Each cell1 In requestsearchrange
IE.document.getElementById("dashboardSelect").Value = "recipientSid"
IE.document.getElementById("quickSearchCriteriaVar").Value = cell1.Value
Set tags = IE.document.getElementsByTagName("img")
For Each tagx In tags
If tagx.alt = "Search Request" Then
tagx.Click
End If
Next tagx
Do Until Not IE.Busy
DoEvents
Loop
i = i + 1
Application.StatusBar = i & " Running"
Next cell1
Application.StatusBar = ""
End Sub
这篇关于运行时错误70:权限被拒绝的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!