運行時錯誤70：權限被拒絕

Question

我說錯了

“運行時錯誤70：權限被拒絕”

下面是我收到此錯誤的代碼。

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工作表中的第一個單元格。 之后，我得到這個錯誤。

Answer 1

我認為可能的原因如下：

在代碼的某個點上，您將獲得包含所有帶有img標簽名稱的元素的集合。

稍后代碼進入循環。 在此循環的每次迭代中，都單擊以下標記之一：

tagx.Click

我想這會觸發一些JS腳本並在HTML結構中進行一些更改。 這導致以前獲得的集合不再可用，應該從頭開始獲取。

因此，如果您移動這部分代碼：

Set tags = IE.document.getElementsByTagName("img")

進入此循環，它應該工作。

---

這是經過修改的代碼：

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