excel - 使用 vba 将一列日期循环到 url 行以进行 Web 查询并从 xe.com/currencytables 检索汇率表

Question

我有一列日期(在 Excel 电子表格中)，并且想将这些日期插入到 Web 查询中的 url 行中，以生成我想将它们放入电子表格中的汇率表。例如:

A栏
2019-12-09
2019-12-08
2019-12-07

对于 A 列中的每个日期，我想将它们插入 url 行:
下面是使用 --Get Data 从 Web 录制的 VBA 宏。然后我复制并粘贴 https://www.xe.com/currencytables/?from=USD&date=2019-12-10进入 url(弹出窗口)，点击确定并选择表 0 以生成日期为 2019-12-10 的汇率表。我想自动化这个过程并使用 A 列中的日期。我没有任何电源查询经验。提前谢谢你的帮助。

Sub Macro2()
'
' Macro2 Macro
'

'
    ActiveWorkbook.Queries.Add Name:="Table 0 (6)", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Web.Page(Web.Contents(""https://www.xe.com/currencytables/?from=USD&date=2019-12-08""))," & Chr(13) & "" & Chr(10) & "    Data0 = Source{0}[Data]," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Data0,{{""Currency code ??"", type text}, {""Currency name ??"", type text}, {""Units per USD"", type number}, {""USD per Unit"", type number}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Changed Type"""
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 0 (6)"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Table 0 (6)]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Table_0__6"
        .Refresh BackgroundQuery:=False
    End With

End Sub

Answer 1

对于测试，我更改了网址:

    ActiveWorkbook.Queries.Add Name:="Table 0 (6)", Formula:= _
    "let" & Chr(13) & "" & Chr(10) & "    Source = Web.Page(Web.Contents(""https://www.xe.com/currencytables/?from=USD&date=" & Format(DateSerial(2019, 12, 8), "yyyy-mm-dd") & """))," & Chr(13) & "" & Chr(10) & "    Data0 = Source{0}[Data]," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Data0,{{""Currency code"", type text}, {""Currency name"", type text}, {""Units per USD"", type number}, {""USD per Unit"", type number}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Changed Type"""
ActiveWorkbook.Worksheets.Add

因此，在 format(dateserial()) 下，您可以将变量与单元格中的日期放在一起。

我也改了 货币代码 ？？ 和 货币名称？？ 至 货币代码 和 币种名称并以相同的方式在 Excel 的电源查询编辑器中手动编辑它们，因为列名中的这些箭头存在问题。

如果您想一次为所有日期生成表格，那么您必须使用列名中的箭头来解决该问题(或者它已经解决了？)。

下一步是确保表名是唯一的并且是自动生成的。

最后一步是 for 循环遍历带有日期的单元格。

更新:

好的，您可以在下面找到更新的代码。我已经删除了带有特殊字符的有问题的列的列格式。已创建表名称和日期的变量，因此现在可以非常轻松地扩展该代码以创建您想要多少历史数据的表 :)

Option Explicit

Sub DownloadExchangeRates()
    'Set variables
        Dim wb As Workbook
        Dim wbs As Worksheet

        Dim mydate As Date
        Dim table_name As String
        Dim table_display_name As String

        Set wb = ThisWorkbook

        mydate = DateSerial(2019, 12, 7)
        table_name = "Table " & Format(mydate, "yyyy-mm-dd")
        table_display_name = "Table_" & Format(mydate, "yyyy_mm_dd")

    ' Create connection
        wb.Queries.Add _
            Name:=table_name, _
            Formula:= _
            "let" & Chr(13) & "" & Chr(10) & _
            "    Source = Web.Page(Web.Contents(""https://www.xe.com/currencytables/?from=USD&date=" & Format(mydate, "yyyy-mm-dd") & """))," & Chr(13) & "" & Chr(10) & _
            "    Data0 = Source{0}[Data]," & Chr(13) & "" & Chr(10) & _
            "    #""Changed Type"" = Table.TransformColumnTypes(Data0,{{""Units per USD"", type number}, {""USD per Unit"", type number}})" & Chr(13) & "" & Chr(10) & _
            "in" & Chr(13) & "" & Chr(10) & _
            "    #""Changed Type"""

    'Create new worksheet
        wb.Worksheets.Add
        Set wbs = wb.ActiveSheet
        wbs.Name = "Currency for " & Format(mydate, "yyyy-mm-dd")

        With wbs.ListObjects.Add(SourceType:=0, Source:= _
            "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & """" & table_name & """" & ";Extended Properties=""""" _
            , Destination:=Range("$A$1")).QueryTable
            .CommandType = xlCmdSql
            .CommandText = Array("SELECT * FROM [" & table_name & "]")
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .PreserveColumnInfo = True
            .ListObject.DisplayName = table_display_name
            .Refresh BackgroundQuery:=False
        End With

End Sub