整个代码试图使用VBA从Yahoo Finance获取历史数据。一切都很好,除了代码,我试图从雅虎网站获取公司的名称。
这第一段代码只是为了说明变量或其他内容中的定义没有错误。
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
我注意到这不是获得我想要的最有效方式。首先,我想学习如何完成它,然后我将承担该计划的效率。
编辑:使用一些答案,我编辑了一下代码,它仍然显示错误(错误438):
Set xobj = objIe.querySelectorAll("[reactid=239]")
答案 0 :(得分: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