IE Automation-VBA错误-运行时错误70:权限被拒绝

Question

朋友们，我是VBA的新手，我正在尝试从内部网站收集数据。过程如下：在A3至End列中输入的序列号很少。宏应该导航到URL-->从excel中选择序列号-->在搜索字段中输入，然后单击搜索。一旦结果被填充到页面上，它就会抓取特定的值并填充到excel表中。

页面打开良好，数据是从excel中提取的，当宏读取表单元格时，它会给出Runtime 70错误。以下是我的代码供参考。如有任何帮助，我们将不胜感激。

Sub Type1_Data()
Dim ie As InternetExplorer
Dim html As MSHTML.HTMLDocument
Dim RowNumber, ColumnNumber As Long
RowNumber = 3
ColumnNumber = 0
Dim i As Long
Dim HTMLDoc As MSHTML.HTMLDocument
Dim Filt As MSHTML.IHTMLElement
Dim mtbl As MSHTML.IHTMLElement
Dim strempid As MSHTML.HTMLElementCollection
Dim strempid1 As MSHTML.HTMLElementCollection
Dim strempid2 As MSHTML.HTMLElementCollection
Dim strempid3 As MSHTML.HTMLElementCollection
Dim strempid4 As MSHTML.HTMLElementCollection
Dim strempid5 As MSHTML.HTMLElementCollection
Dim strempid6 As MSHTML.HTMLElementCollection
Set ie = New InternetExplorer
ie.Visible = False
ie.navigate ("URL")
Do While ie.READYSTATE = 4: DoEvents: Loop
Do Until ie.READYSTATE = 4: DoEvents: Loop
Set HTMLDoc = ie.document
xy:
If HTMLDoc.Title <> "Marketplace | Find a professional" Then
ie.Visible = True

GoTo xy
End If
ie.Visible = True
ThisWorkbook.Activate
Dim Ed As Integer
Ed = 3
While ThisWorkbook.Sheets("ProM Search").Cells(Ed, 1).Value <> 0
Ed = Ed + 1
Wend
Ed = Ed - 1
For i = 3 To Ed
Application.ScreenUpdating = True
Set UID = HTMLDoc.getElementById("navSelect")
Set Filt = HTMLDoc.getElementById("searchText")
Set mtbl = HTMLDoc.getElementsByTagName("Table")(23)
Application.Wait DateAdd("s", 1, Now)
HTMLDoc.getElementById("NLQTextArea").Value = ThisWorkbook.Sheets("ProM Search").Cells(i, 1).Value
HTMLDoc.getElementById("submitAction").Click
Set strempid = mtbl.getElementsByClassName("dojoxGridCell")(1)
Set strempid1 = mtbl.getElementsByClassName("dojoxGridCell")(2)
Set strempid2 = mtbl.getElementsByClassName("dojoxGridCell")(3)
Set strempid3 = mtbl.getElementsByClassName("dojoxGridCell")(7)
Set strempid4 = mtbl.getElementsByClassName("dojoxGridCell")(9)
Set strempid5 = mtbl.getElementsByClassName("dojoxGridCell")(11)
Set strempid6 = mtbl.getElementsByClassName("dojoxGridCell")(12)
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = strempid.innerText
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = strempid1.innerText
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = strempid2.innerText
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = strempid3.innerText
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = strempid4.innerText
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = strempid5.innerText
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = strempid6.innerText
ActiveCell.Offset(1, -7).Activate
DoEvents
If ActiveCell.Value = "" Then
MsgBox "Fetching Completed Successfully", vbExclamation, "ProM - Open Seat Search T2"
GoTo qt
End If
Next
qt:
ie.Quit
Set ie = Nothing
Set HTMLDoc = Nothing
End Sub

Answer 1

HTMLDoc.getElementById("submitAction").Click可能会导致页面刷新，从而使任何引用的元素变得过时。当执行可能/已知会导致页面刷新/更新的操作时，请尝试始终使用ie.document，而不是设置为变量。这是权限被拒绝错误的常见原因。

您的If End If可能是一个超时的循环。你只需要一个ie.visible = True。在我看来，你很少从设置Visible到false中获益。如果你打算向用户隐藏它，你应该从一开始就这样做，除非它干扰了功能。

Application.ScreenUpdating = True没有任何意义，因为它在这个子节点内从未关闭。如果这个子节点被调用，那么你只需要它在循环外一次。您重复的ActiveCell.Offset(0, 1).Activate可以只使用带有Select Case的循环，并直接设置值而不激活。重复Do While ie.READYSTATE = 4: DoEvents: Loop行没有任何作用。

您可以使用范围的Find方法来确定第1列中0出现的行，而不是沿着列往下走。并进行测试以确定其被发现并且>3.

Answer 2

此错误表示试图写入受写保护的磁盘或访问锁定的文件。您可以检查访问工作表是否需要特殊权限。有关详细原因和解决方案，请参阅本文档。

此外，您还可以参考我关于在VBA中读取单元格值的工作示例：

Sub LOADIE()
Set ieA = CreateObject("InternetExplorer.Application")
ieA.Visible = True
ieA.navigate "https://www.bing.com"
Do Until ieA.readyState = 4
DoEvents
Loop
Set doc = ieA.Document
Dim tempStr As String
tempStr = "sb_form_q"
doc.getElementById(tempStr).Value = ThisWorkbook.Sheets("SheetName").Range("E2").Value
End Sub