vba - 我的脚本在循环单击链接时抛出错误
问题描述
我在 vba 中结合 IE 编写了一个脚本来执行点击连接到网页的每个配置文件的一些 javascript 链接。我的脚本可以完美地单击第一个链接,但是在第二次迭代中单击下一个链接时,它会引发permission denied
错误。每个配置文件都有有效链接,因此我无法将链接用作导航。如何修改我的脚本以循环点击链接?
这是我的脚本:
Sub ClickLinks()
Const Url As String = "https://intraweb.stockton.edu/eyos/page.cfm?siteID=58&pageID=7&action=dirmain&type=FAC&display=basic"
Dim IE As New InternetExplorer, Htmldoc As HTMLDocument, I&
With IE
.Visible = True
.navigate Url
While .Busy = True Or .readyState < 4: DoEvents: Wend
Set Htmldoc = .document
End With
With Htmldoc.querySelectorAll("#main table tr a")
For I = 0 To .Length - 1
.Item(I).Click 'in second iteration this line throws permission denied error
Application.Wait Now + TimeValue("00:00:03")
Next I
End With
End Sub
解决方案
使用 XHR 请求。以下是GET
检索所有员工 ID 的初始请求。然后它循环为每个 id 发出POST
请求的 id。为了显示它访问每个页面,我从每个页面检索员工电子邮件地址。
Option Explicit
Public Sub GetInfo()
Dim objHTTP As Object, URL As String, html As New HTMLDocument, i As Long, sBody As String
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "https://intraweb.stockton.edu/eyos/page.cfm?siteID=58&pageID=7&action=details"
With objHTTP
.Open "GET", "https://intraweb.stockton.edu/eyos/page.cfm?siteID=58&pageID=7&action=dirmain&type=FAC&display=basic", False
.send
html.body.innerHTML = .responseText
Dim staffIDs As Object
Set staffIDs = html.querySelectorAll("input[name=employeeID]")
For i = 0 To staffIDs.Length - 1
sBody = "employeeID=" & staffIDs(i).getAttribute("value")
.SetTimeouts 10000, 10000, 10000, 10000
.Open "POST", URL, False
.setRequestHeader "User-Agent", "User-Agent: Mozilla/5.0 (Windows NT 6.3; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/66.0.3359.181 Safari/537.36"
.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
On Error Resume Next
.send (sBody)
If Err.Number = 0 Then
If .Status = "200" Then
html.body.innerHTML = .responseText
Else
Debug.Print "HTTP " & .Status & " " & .statusText
Exit Sub
End If
Else
Debug.Print "Error " & Err.Number & " " & Err.Source & " " & Err.Description
Exit Sub
End If
On Error GoTo 0
Debug.Print html.querySelector("td a").innerText
Next i
End With
End Sub
登陆页面上的示例视图:
从页面打印输出示例代码:
笨拙的基于时间的等待刷新,然后导航回登录页面,以便可以提交下一个表单。这需要改进和重新排序。
Option Explicit
Public Sub ClickLinks2()
Const URL As String = "https://intraweb.stockton.edu/eyos/page.cfm?siteID=58&pageID=7&action=dirmain&type=FAC&display=basic"
Dim IE As New InternetExplorer, Htmldoc As HTMLDocument, i&
With IE
.Visible = True
.navigate URL
While .Busy = True Or .readyState < 4: DoEvents: Wend
Set Htmldoc = .document
Dim numEmployees As Long, a As Object
numEmployees = Htmldoc.querySelectorAll("a.names").Length
For i = 1 To 3 'numEmployees (1-792)
While .Busy = True Or .readyState < 4: DoEvents: Wend
.navigate URL
Application.Wait Now + TimeSerial(0, 0, 5)
.document.parentWindow.execScript "document.form" & i & ".submit();" ''javascript:document.form1.submit(); ''<== Adapted this
Next i
End With
End Sub
推荐阅读
- react-native - Expo Android App Build 卡在 Axios 请求上
- node.js - FirebaseAuthError:`developerClaims` 参数必须是包含开发人员声明的有效、非空对象
- python - 如何在python中打印这个数字模式?
- javascript - 在 React 应用程序中使用 Aladin Lite 应用程序(不是为 React 构建的)
- c# - NLog 设置不删除 MaxArchiveDays 或 MaxArchiveFiles?
- ansible - 在 ansible 任务中使用 async 会引发特权错误
- tensorflow - 无法在 google colab 上运行相同的代码(tensorflow read_file 错误)
- wordpress - WordPress 编辑部分无法正常工作
- r - Create a binary wide table from a long table (like tidyr::spread() )
- node.js - 如何减少 Firebase Cloud Functions Firestore onWrite 触发器中已删除文档的数量?