VBAmacrosExcel中不加载网页

我已经在VBAmacrosExcel中编写了一个代码。 我正在尝试在网站上search请求ID,然后使用两个date(开始和结束)筛选数据。

search后,网站正在加载正确,但只要代码inputdate,并点击filterbutton网站不会完全加载。 它直接从Excel工作表中取得另一个ID,并在search框中input它,而不用等待datefilter应用的网站加载。

以下是代码:

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 

我试图点击下面的代码中的filter,然后等待它加载,但它不工作。

 For Each tagsx In tags2 If tagsx.ID = "filterBtn" Then tagsx.Click Do Until Not IE.Busy DoEvents Loop End If Next tagsx