下载数据VBA运行时间错误5

Question

Sub Download()
Dim fromCurr As String, endDate As String, str As String
fromCurr = Sheets("Currencies").Range("fromCurr").Value
endDate = Sheets("Currencies").Range("endDate").Value
Sheets("Data").Cells.Clear
str = "http://www.xe.com/currencytables/?from=" _
    & fromCurr _
    & "&date=" _
    & Year(endDate) & "-" & Month(endDate) & "-" & Day(endDate)

    With Sheets("Data").QueryTables.Add(Connection:= _
    "URL;" & str, Destination _
    :=Range("$D$3"))
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = """historicalRateTbl"""
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
    End With
    End Sub

我正在尝试从给定指定货币和数据的网站下载货币数据。(在此网站上

每当我运行宏时，都会出现运行时错误5。

Answer 1

我将您的日期格式更改为迫使两位数的月和一天，并摆脱了范围的ActiveSheet父母(" D3"(。这对我有用= today((在范围内(" enddate"(。

Option Explicit
Sub Download()
    Dim fromCurr As String, endDate As Long, str As String
    fromCurr = Worksheets("Currencies").Range("fromCurr").Value
    endDate = Worksheets("Currencies").Range("endDate").Value
    Worksheets("Data").Cells.Clear
    str = "http://www.xe.com/currencytables/?from=" _
        & fromCurr _
        & "&date=" _
        & Format(endDate, "yyyy-mm-dd")
    Debug.Print str
    With Worksheets("Data")
        With .QueryTables.Add(Connection:="URL;" & str, Destination:=.Range("D3"))
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlSpecifiedTables
            .WebFormatting = xlWebFormattingNone
            .WebTables = """historicalRateTbl"""
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
    End With
End Sub