2016-12-20 2 views
0

Весь код пытается получить исторические данные от Yahoo Finance с помощью VBA. Все работает очень хорошо, кроме кода, в котором я пытаюсь получить название компании, используя сайт Yahoo.Получите данные о запасах/компаниях от Yahoo Finance, используя VBA

Этот первый фрагмент кода предназначен только для того, чтобы исключить ошибки в определении переменных или что-то еще.

Enum READYSTATE 
READYSTATE_UNINITIALIZED = 0 
READYSTATE_LOADING = 1 
READYSTATE_LOADED = 2 
READYSTATE_INTERACTIVE = 3 
READYSTATE_COMPLETE = 4 
End Enum 

Sub GetData() 
    Dim datasheet As Worksheet 
    Dim EndDate As Date 
    Dim StartDate As Date 
    Dim symbol As String 
    Dim qurl As String 
    Dim nQuery As Name 
    Dim LastRow As Integer 
    Dim ohtml As HTMLText 

On Error GoTo error_getdata 

    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
    Application.Calculation = xlCalculationManual 
    Set datasheet = ActiveSheet 

    StartDate = datasheet.Range("startDate").Value 
    EndDate = datasheet.Range("endDate").Value 
    symbol = datasheet.Range("ticker").Value 
    symbol = UCase(symbol) 

    'Download data from Yahoo Finance' 
    Sheets("Home").Activate 
    Sheets(symbol).Range("a1").CurrentRegion.ClearContents 

    qurl = "http://ichart.finance.yahoo.com/table.csv?s=" & symbol 
    qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _ 
      "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _ 
      Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Sheets(symbol).Range("a1") & "&q=q&y=0&z=" & _ 
      symbol & "&x=.csv" 
    eurl = "https://finance.yahoo.com/quote/" & symbol & "?ltr=2" 

Здесь находится проблема. Я пытаюсь отказаться от html сайта, ищущего название компании. Если я посмотрю на html-код веб-сайта, я считаю, что название компании обозначено как reactid = "239". Я предполагаю, что мне нужно использовать getelementsbyID («239»), но я не уверен в этом.

''''' 
Dim objIe As Object 

Set objIe = CreateObject("InternetExplorer.Application") 
objIe.Visible = False 
objIe.navigate eurl 
    Application.StatusBar = "Looking for information in Yahoo Finance" 
While (objIe.Busy Or objIe.READYSTATE <> 4): DoEvents: Wend 
Set xobj = objIe.querySelectorAll("[reactid=239]") 
Debug.Print xobj.innerText 
Set xobj = Nothing 
objIe.Quit 
Set objIe = Nothing 
Application.StatusBar = "" 

'Sort the existence of a ticker in our sheet and create a new one ' 
    Dim worksh As Integer 
    Dim worksheetexists As Boolean 
    Dim x As Integer 
    worksh = Application.Sheets.Count 
    worksheetexists = False 
    For x = 1 To worksh 
     If Worksheets(x).Name = symbol Then 
      worksheetexists = True 
      Sheets(symbol).Delete 
      ActiveWorkbook.Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = symbol 
      Exit For 
     End If 
    Next x 
    If worksheetexists = False Then 
     ActiveWorkbook.Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = symbol 
    End If 

' Load data ' 
QueryQuote: 
    With Sheets(symbol).QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets(symbol).Range("a1")) 
     .BackgroundQuery = True 
     .TablesOnlyFromHTML = False 
     .Refresh BackgroundQuery:=False 
     .SaveData = True 
    End With 

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

    Sheets(symbol).Columns("A:G").ColumnWidth = 12 

    'Sort data' 
    LastRow = Sheets(symbol).UsedRange.Row - 2 + Sheets(symbol).UsedRange.Rows.Count 

    Sheets(symbol).Sort.SortFields.Add Key:=Range("A2"), _ 
     SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
    With Sheets(symbol).Sort 
     .SetRange Range("A1:G" & LastRow) 
     .Header = xlYes 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
     .SortFields.Clear 
    End With 
Exit Sub 

error_getdata: 
    MsgBox ("Fatal error. Please insert a valid sticker for the stock") 
End Sub 

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

Edit: Используя некоторые ответы, я редактировал чуток код, он по-прежнему появляется сообщение об ошибке (ошибка 438) на линии:

Set xobj = objIe.querySelectorAll("[reactid=239]") 
+0

'getElementsByID()' будет работать только для 'ид =«ExampleID»' атрибутов, 'reactid' не будет классифицироваться как атрибут 'id' методом' getElementsByID() ' – Jordan

+0

И каким методом следует классифицировать' reactid'? –

+1

в "http://ichart.finance.yahoo.com/table.csv?s=" & symbol . Можете ли вы привести нам пример символа? –

ответ

1

Я бы смотреть в использовании http://www.w3schools.com/jsref/met_document_queryselectorall.asp

который может разрешить выбор узлов, используя синтаксис селекторов CSS и есть ссылка на этот синтаксис в http://www.w3schools.com/cssref/css_selectors.asp

Так что, возможно, что-то вдоль линий

document.querySelectorAll("[reactid=239]") 

Кстати, вы можете просматривать библиотеку, если вы используете инструменты Ссылка на

Microsoft HTML Object Library   
+0

Это не сработало, но я узнал другие вещи благодаря вашему ответу. –

+0

@Alejandro Jiménez Rico: Хммм, да, я подтвердил ошибку, запускающую ваш код. Глупый Microsoft! Предполагается, что это функция HTML5, и она выглядит сломанной. Однако 'objIe.document.querySelectorAll (" h1 "). Пункт (6) .innerText' указывает название компании. Вы можете получить все теги h1 и прокрутить для защиты от изменения структуры документа. –

Смежные вопросы