Question

首先，我不得不承认我对VBA不是很擅长。我尝试调整this和this网站的代码，以便在给定的股票代码列表中下载我需要的信息。我在“数据”表A的列A中有一个代码清单，并希望从列c开始，在右侧的列中输入下载的信息（名称，交换，出价，询问等）。我想通过单击按钮来运行宏（从而更新所有值）。我试图相应地调整代码，但继续遇到我无法调试的错误。你可以帮助我帮助我获得正确的代码吗？

提前非常感谢！

错误

Sub DownloadStockQuotes(ByVal stockTicker As String, ByVal DestinationCell As String)

    Dim qurl As String
    Dim StartMonth, StartDay, StartYear, EndMonth, EndDay, EndYear As String
    Dim C As WorkbookConnection
    StartMonth = Format(Month(StartDate) - 1, "00")
    StartDay = Format(Day(StartDate), "00")
    StartYear = Format(Year(StartDate), "00")

    EndMonth = Format(Month(EndDate) - 1, "00")
    EndDay = Format(Day(EndDate), "00")
    EndYear = Format(Year(EndDate), "00")
    qurl = "URL;http://finance.yahoo.com/d/quotes.csv?s=" + stockTicker + "&f=nxj1b4abc1p2"

    On Error GoTo ErrorHandler:
    With ActiveSheet.QueryTables.Add(Connection:=qurl, Destination:=Range(DestinationCell))
        .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 = "20"
        '    .WebPreFormattedTextToColumns = True
        '    .WebConsecutiveDelimitersAsOne = True
        '    .WebSingleBlockTextImport = False
        '    .WebDisableDateRecognition = False
        '    .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
ErrorHandler:

End Sub

Sub DownloadData()

    Dim frequency As String
    Dim numRows As Integer
    Dim lastRow As Integer
    Dim lastErrorRow As Integer
    Dim lastSuccessRow As Integer
    Dim stockTicker As String

    Application.ScreenUpdating = False

    lastRow = Worksheets("Kursabruf").Cells(Rows.Count, "a").End(xlUp).Row

    'Loop through all tickers
    For ticker = 2 To lastRow

        stockTicker = Worksheets("Kursabruf").Range("$a$" & ticker)

        If stockTicker = "" Then
            GoTo NextIteration
        End If

        Call DownloadStockQuotes(stockTicker, "$c$2")
        Worksheets("Kursabruf").Columns("c:c").TextToColumns Destination:=Range("c2"), DataType:=xlDelimited, _
                                     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                                     DecimalSeparator:=".", ThousandsSeparator:=" ", _
                                     Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))

        Sheets(stockTicker).Columns("A:G").ColumnWidth = 10

        lastRow = Sheets(stockTicker).UsedRange.Row - 2 + Sheets(stockTicker).UsedRange.Rows.Count

            GoTo NextIteration

        'Delete final blank row otherwise will get ,,,, at bottom of CSV
        Sheets("Kursabruf").Rows(lastRow + 1 & ":" & Sheets("Kursabruf").Rows.Count).Delete


NextIteration:
    Next ticker

    Application.DisplayAlerts = False


ErrorHandler:

    Worksheets("Parameters").Select
    For Each C In ThisWorkbook.Connections
        C.Delete
    Next

End Sub

VBA股票信息检索到Excel

0 个答案: