Question

我使用VAB抓取了一个网站（在代码中提到），并将数据存储在excel文件中。我的用户表单有一个“选择今天的数据”的选项按钮。因此，我试图修改以下代码相同。你能帮帮我吗？我尝试了几种选择，但无法达到我想要的效果。

以下是代码：

Public Sub Extract_TD_text()

Dim URL As String
Dim IE As InternetExplorer
Dim HTMLdoc As HTMLDocument
Dim TRelements As IHTMLElementCollection
Dim TRelement As HTMLTableCell

Dim r As Long
Dim i As Long
Dim offSet As Integer
Dim maxOffSet As Integer
Dim currentDate As Date

URL = "https://www.gebiz.gov.sg/scripts/main.do?sourceLocation=openarea&select=tenderId"
Sheet1.Cells.ClearContents
Set IE = New InternetExplorer
offSet = 0
r = 0
k = 0

If UserForm1.OptionButton1.Value = True Then
cuerrentDate = Date

With IE
    .navigate URL
    .Visible = True
     'Wait for page to load
    While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
    Set InputElements = .document.getElementsByTagName("input")
    For Each InputElement In InputElements
        If InputElement.getAttribute("name") = "strBtnLast" Then
            maxOffSet = CInt(Split(Split(InputElement.getAttribute("onclick"), "Navigator(")(1), ")")(0))
        End If
    Next
    While offSet <= maxOffSet
        offSet = offSet + 10
        Set TRelements = .document.getElementsByTagName("tr")
        For Each TRelement In TRelements
         'Look for required TD elements - this check is specific to VBA Express forum - modify as required
            If TRelement.className = "row_even" Or TRelement.className = "row_odd" Or TRelement.className = "header_subone" Then
                i = 0
                For Each Child In TRelement.ChildNodes
                    Sheet1.Range("A1").offSet(r, i).Value = Child.innerText
                    i = i + 1
                Next
                r = r + 1
            End If
        Next
        If offSet <= 10 Then
            Sheet1.Rows(1).Delete
            Sheet1.Rows(1).Delete
            r = r - 2
        End If
        If offSet > 10 Then
            Sheet1.Rows(offSet - 8).Delete
            Sheet1.Rows(offSet - 8).Delete
            Sheet1.Rows(offSet - 8).Delete
            r = r - 3
        End If
        .document.parentWindow.execScript "submitHTMLTableNavigator(" + CStr(offSet) + ");"
        While .Busy Or .readyState <> READYSTATE_COMPLETE: DoEvents: Wend
    Wend
    'Sheet1.Range("A:F").WrapText = False
    IE.Quit
End With
End If
End Sub

期待有人在这里帮助我。提前感谢你。

干杯。

Answer 1

这个过滤器对我有用：

ActiveSheet.Range("$A$1").CurrentRegion.AutoFilter _
           Field:=4, Criteria1:=">=10/13/2014", Operator:=xlAnd, _
           Criteria2:="<=10/14/2014"

如何使用VBA代码从网站上获取所选日期的数据？

1 个答案: