使用VBA从Yahoo Finance获取股票/公司名称
整个代码尝试使用VBA从Yahoo Finance获取历史数据。 除了代码，我试图从雅虎网站获取公司的名字，一切都很好。
这第一段代码只是为了在variables或其他方面定义没有错误。
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]")
我会考虑使用http://www.w3schools.com/jsref/met_document_queryselectorall.asp
它可以允许使用CSSselect器语法来select节点，并且在http://www.w3schools.com/cssref/css_selectors.asp上有这个语法的参考
所以也许是沿着这条线
document.querySelectorAll("[reactid=239]")
顺便说一下，如果使用“工具参考”来浏览库
Microsoft HTML Object Library