VBA Фондовый поиск информации в Excel

Прежде всего, я должен признать, что я не очень хорош в VBA. Я пытался адаптировать код с этого и этого сайта, чтобы загрузить информацию, которая мне нужна, в списке заданных тикеров. У меня есть список тикеров в столбце А листа "данные", и я хочу, чтобы загруженная информация (имя, обмен, заявка, запрос и т. Д.) Была в столбцах справа, начиная с столбца с. Я хочу запустить макрос (и, таким образом, обновить все значения) одним нажатием на кнопку. Я попытался соответствующим образом адаптировать код, но продолжаю сталкиваться с ошибками, которые не могу отладить. Можете ли вы эксперты помочь мне получить правильный код?

Большое спасибо заранее!

ошибка


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

0 ответов

Другие вопросы по тегам