Mike Simmons UK Ответов: 1

Загрузка цен акций из Yahoo Finance с помощью Excel VBA-Refresh BackgroungQuery:Fals

Привет
Загрузка цен акций из Yahoo Finance по списку действительных кодов акций работает нормально, например

AA, AXP, BA, C, CAT, D etc.

Используемая кодировка кавычек запроса выглядит следующим образом:

QueryQuote:
With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("C7"))
                .BackgroundQuery = True
                .TablesOnlyFromHTML = False
                .Refresh BackgroundQuery:=False
                .SaveData = True
            End With

            Range("C7").CurrentRegion.TextToColumns Destination:=Range("C7"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                Semicolon:=False, Comma:=True, Space:=False, other:=False

    Range("C1:I1").Select
    Selection.ColumnWidth = 8


Проблема, с которой я сталкиваюсь, заключается в том, что если список биржевых кодов включает недопустимый код (в этом примере я использовал " VVV " или биржевой код, который действителен, но отсутствует в базе данных Yahoo на конкретную дату загрузки, отображается следующее сообщение об ошибке:

"Run Time Error 1004 Unable To open<br />
<br />
http://chart.yahoo.com/table.csv?s=vvv&a=1&b=3&c=2011&d=1&e=The Internet site reports that the item you requested could not be found (HTTP/1.0 404)"


Система останавливается, и я не могу двигаться вперед.

Об отладке - .Refresh BackgroundQuery:=False подсвечивается.

Я хотел бы иметь возможность добавить код, который пропускал бы любые недействительные записи, такие как вышеприведенные, и который затем получал бы доступ к следующему действительному коду акции и загружал бы цену акции против этого.

Любая душа, которую кто-либо мог бы предоставить, была бы очень признательна.



С уважением



Майк Симмонс

1 Ответов

Рейтинг:
2

Maciej Los

Какая версия MS Excel: 2007?

На мой взгляд, ваш код не является оптимальным и не имеет контекста.
Почему?
1) Попробуйте запустить этот код на листе 1, листе 2 или листе 3 и на любом листе с данными. Вы потеряете свои данные!
2) ваше приложение так же быстро, как и ваш код.

Option Explicit 'declare variables

Sub CreateQT(qurl As String)
Dim wsh As Worksheet, dstRange As Range
Dim qt As QueryTable

'ignore errors and delete existing QueryTable
On Error Resume Next
Set qt = wsh.QueryTables(1)
If Not qt Is Nothing Then qt.Delete

'on error go to error handler
On Error GoTo Err_CreateQT

'create object variable: Worksheet
Set wsh = ThisWorkbook.Worksheets(1)
'create object variable: Range
Set dstRange = wsh.Range("C7")
'create object variable: QueryTable
Set qt = wsh.QueryTables.Add("URL;" & qurl, dstRange, sSQL)
With qt
    .BackgroundQuery = True
    .TablesOnlyFromHTML = False
    .SaveData = True
End With

dstRange.TextToColumns Destination:=dstRange, DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=True, Space:=False, other:=False
wsh.UsedRange.ColumnWidth = 8

Exit_CreateQT:
    On Error Resume Next
    'delete every object variables
    Set dstRange = Nothing
    Set wsh = Nothing
    Set qt = Nothing
    Exit Sub
    
Err_CreateQT:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_CreateQT
End Sub