网页未加载到VBA宏Excel中

Question

我在VBA宏Excel中编写了代码。我试图在网站上搜索请求ID，然后使用两个日期（开始和结束）过滤数据。

在搜索到ID之后，网站正在正确加载，但是一旦代码输入日期并单击过滤器按钮，网站就不会完全加载。它直接从excel表中获取另一个ID并在搜索框中输入它，而不等待应用的日期过滤器的网站加载。

以下是代码：

@Check

我正在尝试点击下面代码中的过滤器，然后等待它加载，但它无法正常工作。

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
    Dim tag3 As Object
    Dim tag3x As Object
    Dim revocdate2 As String

    Application.DisplayStatusBar = True

    i = 0

    With ActiveWorkbook.Sheets("FalseRevokes")
        Set requestsearchrange = .Range(.Range("B2"), .Range("B2").End(xlDown))
    End With

    ActiveWorkbook.Worksheets.Add
    ActiveWorkbook.ActiveSheet.Name = "Request Check"

    With ActiveWorkbook.Sheets("Request Check")
        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/QuickSearch")

    '-----------------------------------------------------------------------------------------------------------------
    '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 request submission date")
    revocdate2 = InputBox("Enter the Request Submission date limit")

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

    Set tag3 = IE.document.getElementsByTagName("input")

    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

        Set tags2 = IE.document.getElementsByTagName("input")

        For Each tagsx In tags2
            If tagsx.ID = "startDtsubmittedDate" Then
                tagsx.Value = revocdate
            End If
        Next tagsx
        For Each tagsx In tags2
            If tagsx.ID = "endDtsubmittedDate" Then
                tagsx.Value = revocdate2
            End If
        Next tagsx
        For Each tagsx In tags2
            If tagsx.ID = "filterBtn" Then
                tagsx.Click
                'Do Until Not IE.Busy
                    'DoEvents
                'Loop
            End If
        Next tagsx
        'IE.document.getElementById("startDtsubmittedDate").Value = revocdate
        'IE.document.getElementById("endDtsubmittedDate").Value = revocdate2
        'IE.document.getElementById("filterBtn").Click

        Do Until Not IE.Busy
            DoEvents
        Loop

        i = i + 1
        Application.StatusBar = i & " Running"


    Next cell1

    Application.StatusBar = ""

    'For Each cell1 In requestsearchrange

        'With ActiveSheet.QueryTables.Add(Connection:= _
            '"URL;https://ibid.abc.com/RMT/SearchRequest.action?searchField=recipientSid&quickSearchCriteria =" & cell1.Value & "&listObjName=request&viewAll=&noOfRecords=" _
            ', Destination:=Range("$A$1").End(xlDown))
            '.Name = _
            '"SearchRequest.action?searchField=recipientSid&quickSearchCriteria=V650460&listObjName=request&viewAll=&noOfRecords="
            '.FieldNames = True
            '.RowNumbers = False
            '.FillAdjacentFormulas = False
            '.PreserveFormatting = True
            '.RefreshOnFileOpen = False
            '.BackgroundQuery = True
            '.RefreshStyle = xlInsertDeleteCells
            '.SavePassword = False
            '.SaveData = True
            '.AdjustColumnWidth = True
            '.RefreshPeriod = 0
            '.WebSelectionType = xlEntirePage
            '.WebFormatting = xlWebFormattingNone
            '.WebPreFormattedTextToColumns = True
            '.WebConsecutiveDelimitersAsOne = True
            '.WebSingleBlockTextImport = False
            '.WebDisableDateRecognition = False
            '.WebDisableRedirections = False
            '.Refresh BackgroundQuery:=False
        'End With



        'For Each cell2 In entire
            'If cell2.Value <> "Completed" Or cell2.Value = "Cancelled" Or cell2.Value = "Rejected" Or cell2.Value = "Reopened" Or cell2.Value = "In Progress" Then
                'cell2.Rows.Delete
            'End If
        'Next cell2
    'ActiveCell.Rows("1:62").EntireRow.Select
    'Selection.Delete Shift:=xlUp
    'ActiveCell.Offset(4, 0).Range("A1").Select
    'Next cell1
End Sub