Question

我有这样的网址：

http://www.xyz342.net/abc/date_from=24.05.2018 00:00:00&date_to=24.05.2018 00:00:00&abc=2

我已经使用以下vba代码将表格提取到excel：

Sub GetWebTable()
    With ActiveSheet.QueryTables.Add(Connection:="URL;http://www.xyz342.net/abc/date_from=24.05.2018 00:00:00&date_to=24.05.2018 00:00:00&abc=2", Destination:=Range("a1"))
    .Refresh BackgroundQuery:=False
    .SaveData = True
    End With
End Sub

任务：我想自动提取2018年至今的表格，直到今天。因此，每次(e.g. http://www.xyz342.net/abc/date_from=20.09.2018 00:00:00&date_to=20.09.2018 00:00:00&abc=2 gives the table for 20.09.2018)都必须更改上述给定URL中的日期。我该怎么办？

Perfect将是每天的新工作表。以后的每一天都应该自动添加。

Answer 1

这应该给您一些想法，包括在循环中生成日期并将当前日期连接到URL中。它还演示了如何添加新的工作表。我认为可能有比生成这样的queryTables更好的抓取方法。如果您可以为一个链接共享HTML（并且每天的布局都是相同的），则可以设计出一种更好的方法。

在@ Marcucciby2的评论之后，您可能还会得到startdate，内容如下：startDate = DateSerial(YEAR(Date), 1, 1)

除非刷新历史表，否则您可能只希望运行以下内容一次。然后删除循环，只需从dateString = Format$(Date, "dd.mm.yyyy")或Date-1生成日期即可获得前一天。您提到要自动添加；您可以关联一个更改事件，该更改事件链接到一个单元格，在该单元格中您从下拉列表中选择一个日期。

Option Explicit
Public Sub test()
    Dim url  As String, startDate As Long, endDate As Long, i As Long, dateString As String

    startDate = DateValue("2018-01-01")
    endDate = CLng(Date)

    For i = startDate To endDate
        DoEvents
        dateString = Format$(i, "dd.mm.yyyy")
        url = "http://www.xyz342.net/abc/date_from=" & dateString & " 00:00:00&date_to=" & dateString & " 00:00:00&abc=2"
        AddQueryTable url, dateString
    Next
End Sub

Public Sub AddQueryTable(ByVal url As String, ByVal dateString As String)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets.Add
    ws.NAME = dateString
    On Error Resume Next
    With ws.QueryTables.Add(Connection:="URL;" & url, Destination:=ws.Range("a1"))
        .Refresh BackgroundQuery:=False
        .SaveData = True
    End With
    On Error GoTo 0
End Sub

通过VBA提取多个html表

1 个答案: