VBA获得纳斯达克分析师价格目标(需要实际的美元出现在我的代码中)当前输出工作,但显示0美元


Sub Get_Web_Data2(ByVal Target As Range)
On Error Resume Next
Dim request As Object
Dim response As String
Dim html As New HTMLDocument
Dim website As String
Dim price As Variant


' Website to go to
website = "https://www.nasdaq.com/market-activity/stocks/" & Target.Value & "/analyst-research"

' Create the object that will make the webpage request.

Set request = CreateObject("MSXML2.XMLHTTP")


' Where to go and how to go there - probably don't need to change this.
request.Open "GET", website, False

' Get fresh data.
request.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"

' Send the request for the webpage.
request.send

' Get the webpage response data into a variable.
response = StrConv(request.responseBody, vbUnicode)

' Put the webpage into an html object to make data references easier.
html.body.innerHTML = response

' Get the price from the specified element on the page.
price = html.getElementsByClassName("analyst-target-price__description").Item(0).innerText

' Output the price into a message box.

If Target.Column = 4 Then
Range("P" & Target.Row).Value = price

End If
End Sub

数据是从API调用返回的,因此不会出现在对当前URI的调用中。

更新以调用API。它返回少量json。使用json解析器似乎有些过头了,所以我会选择更快的字符串操作。

值似乎是美元,所以将列p格式化为带有符号$的货币。

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim request As Object
Dim response As String
Dim website As String
website = "https://api.nasdaq.com/api/analyst/" & LCase$(Target.Value) & "/targetprice"

Set request = CreateObject("MSXML2.XMLHTTP")

With request
.Open "GET", website, False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
response = .responseText
End With

Dim price As String

price = Left$(Right$(response, Len(response) - (InStr(response, "priceTarget"":") + Len("priceTarget"":") - 1)), InStr(Right$(response, Len(response) - (InStr(response, "priceTarget"":") + Len("priceTarget"":") - 1)), ",") - 1)
Application.EnableEvents = False

If Target.column = 4 Then
Range("P" & Target.row).Value = price
End If

Application.EnableEvents = True
End Sub

最新更新