QueryTables 循环中的 VBA 错误处理

Question

我正在从 Google 财经导入多个 csv 文件并将数据保存到一个工作表中。每当 URL 无效时，我希望它转到一个错误处理程序，它基本上说“找不到此信息”，然后继续返回以从网络上获取下一个 csv 文件。

代码工作正常，直到它到达一个无效的 url，并执行错误处理程序。错误处理程序第一次完成它的工作，但是当循环继续使用新的 URL 时，即使 url 有效，它也会再次出错。

一旦querytable .Refresh出错一次，之后的每个url即使是合法的url也会出错。有没有办法清除错误并转到下一个 URL？

Code:

Sub getQuotes()

For i = 1 To 3775
    sym = Worksheets("2").Range("C" & i)
    lookup = "TEXT;http://www.google.com/finance/historical?q=" + sym + "&startdate=Jun+1%2C+2016&enddate=Aug+5%2C+2016&num=30&authuser=1&output=csv"
    With Worksheets("Raw Data").QueryTables.Add(Connection:=lookup, Destination:=Worksheets("Raw Data").Range("A2"))
        .Name = _
        " "
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 775
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileDecimalSeparator = ","
        .TextFileTrailingMinusNumbers = True
        On Error GoTo Err1:
        .Refresh BackgroundQuery:=True
    End With
Next

Err1:
Worksheets("Raw Data").Range("A:F").EntireColumn.Insert
Worksheets("Raw Data").Range("A2") = sym + " data could not be extracted"
Resume Next
End Sub

Answer 1

虽然我无法重现您提到的具体问题，但您在错误处理部分之前缺少 Exit Sub。没有它，Err1: 下的代码将在您的 For 循环完成后执行，无论是否有错误。

只需在 Err1: 上方的行中添加 Exit Sub 即可。通过此更改，我的代码在 sym 列表中间出现错误。