IE 自动化 - VBA 错误 - 运行时错误 70：权限被拒绝

Question

朋友们，我对 VBA 很陌生，在这里我试图从内部网站上抓取数据。过程如下： A3 到 End 列中输入的序列号很少。宏应该导航到 URL --> 从 excel 中选择序列号 --> 在搜索字段中输入并单击搜索。在页面上填充结果后，它会抓取特定值并填充到 Excel 工作表中。

页面打开良好，从 excel 中提取数据，当宏读取表格单元格时，它会给出 运行时 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 没有意义，因为它从未在此子中关闭。如果调用了这个 sub，那么你只需要在循环之外使用它一次。您重复的ActiveCell.Offset(0, 1).Activate 可以只使用带有Select Case 的循环并直接设置值而不激活。重复Do While ie.READYSTATE = 4: DoEvents: Loop 行没有任何意义。

您可以使用Find 范围方法来确定第 1 列中出现 0 的行，而不是沿着列向下走。并进行测试以确定它是否找到并且 >=3。

Answer 2

此错误表示尝试写入写保护磁盘或访问锁定文件。您可以检查是否需要特殊权限才能访问工作表。详细原因及解决方法可以参考this doc。

此外，您还可以参考我的工作示例，了解如何在 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