Excel VBA Web源代码 - 如何将多个字段提取到一个工作表

问题描述 投票:1回答:2

大家下午好。在对QHarr非常解决的上一个查询的后续跟进中,我想要从源代码而不是仅仅一个来对多个字段运行已解决的查询。

我使用的URL是:https://finance.yahoo.com/quote/AAPL/?p=AAPL

以及'Previous Close'价格的VBA代码是:

Option Explicit

    Sub PreviousClose()
        Dim html As HTMLDocument, http As Object, ticker As Range
        Set html = New HTMLDocument
        Set http = CreateObject("WINHTTP.WinHTTPRequest.5.1")

    Dim lastRow As Long, myrng As Range
    With ThisWorkbook.Worksheets("Tickers")

        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set myrng = .Range("A2:A" & lastRow)

        For Each ticker In myrng
            If Not IsEmpty(ticker) Then
                With http
                    .Open "GET", "https://finance.yahoo.com/quote/" & ticker.Value & "?p=" & ticker.Value, False
                    .send
                    html.body.innerHTML = .responseText
                End With
                On Error Resume Next
                ticker.Offset(, 1) = html.querySelector("[data-test=PREV_CLOSE-value]").innertext

                On Error GoTo 0
            End If
        Next

    End With
End Sub

无论如何,每个字段理想地位于用于股票的股票行的右侧。

Sheet的屏幕截图:

任何帮助将非常感谢。 谢谢。

excel vba excel-vba web-scraping excel-web-query
2个回答
1
投票

tl;博士

下面的代码适用于给定的测试用例。有更长的列表,请参阅ToDo部分。

API:

如果可能,您希望查看API以提供此信息。我相信Alpha Vantage现在提供雅虎财务API用于*的信息。有一个很好的JS教程here。 Alpha Vantage文档here。在这个答案的最底部,我快速浏览了通过API提供的时间序列函数。

WEBSERVICE功能:

使用API​​密钥,您还可以使用Excel中的Web服务功能来检索和解析数据。例子here。没有测试过。

XMLHTTPRequest和类:

但是,我将向您展示一种使用类和循环URL的方法。你可以改进这一点。我使用一个名为clsHTTP的裸骨类来保存XMLHTTP请求对象。我给它2个方法。一个是GetHTMLDoc,用于在html文档中返回请求响应,另一个是GetInfo,用于从页面返回一系列感兴趣的项目。

以这种方式使用类意味着我们可以节省重复创建和销毁xmlhttp对象的开销,并提供一组很好的描述性公开方法来处理所需的任务。

假设您的数据如图所示,标题行为第2行。

TODO:

IMO的直接明显的开发是你想要添加一些错误处理。例如,你可能想要开发类来处理服务器错误。


VBA:

因此,在您的项目中添加一个名为clsHTTP的类模块并添加以下内容:

clsHTTP

Option Explicit

Private http As Object
Private Sub Class_Initialize()
    Set http = CreateObject("MSXML2.XMLHTTP")
End Sub

Public Function GetHTMLDoc(ByVal URL As String) As HTMLDocument
    Dim html As HTMLDocument
    Set html = New HTMLDocument
    With http
        .Open "GET", URL, False
        .send
        html.body.innerHTML = StrConv(.responseBody, vbUnicode)
        Set GetHTMLDoc = html
    End With
End Function
Public Function GetInfo(ByVal html As HTMLDocument, ByVal endPoint As Long) As Variant
    Dim nodeList As Object, i As Long, result(), counter As Long
    Set nodeList = html.querySelectorAll("tbody td")
    ReDim result(0 To endPoint - 1)
    For i = 1 To 2 * endPoint Step 2
        result(counter) = nodeList.item(i).innerText
        counter = counter + 1
    Next    
    GetInfo = result
End Function

在标准模块中(模块1)

Option Explicit
Public Sub GetYahooInfo()
    Dim tickers(), ticker As Long, lastRow As Long, headers()
    Dim wsSource As Worksheet, http As clsHTTP, html As HTMLDocument

    Application.ScreenUpdating = False

    Set wsSource = ThisWorkbook.Worksheets("Sheet1") '<== Change as appropriate to sheet containing the tickers
    Set http = New clsHTTP

    headers = Array("Ticker", "Previous Close", "Open", "Bid", "Ask", "Day's Range", "52 Week Range", "Volume", "Avg. Volume", "Market Cap", "Beta", "PE Ratio (TTM)", "EPS (TTM)", _
                    "Earnings Date", "Forward Dividend & Yield", "Ex-Dividend Date", "1y Target Est")

    With wsSource
        lastRow = GetLastRow(wsSource, 1)
        Select Case lastRow
        Case Is < 3
            Exit Sub
        Case 3
            ReDim tickers(1, 1): tickers(1, 1) = .Range("A3").Value
        Case Is > 3
            tickers = .Range("A3:A" & lastRow).Value
        End Select

        ReDim results(0 To UBound(tickers, 1) - 1)
        Dim i As Long, endPoint As Long
        endPoint = UBound(headers)

        For ticker = LBound(tickers, 1) To UBound(tickers, 1)
            If Not IsEmpty(tickers(ticker, 1)) Then
                Set html = http.GetHTMLDoc("https://finance.yahoo.com/quote/" & tickers(ticker, 1) & "/?p=" & tickers(ticker, 1))
                results(ticker - 1) = http.GetInfo(html, endPoint)
                Set html = Nothing
            Else
                results(ticker) = vbNullString
            End If
        Next

        .Cells(2, 1).Resize(1, UBound(headers) + 1) = headers
        For i = LBound(results) To UBound(results)
            .Cells(3 + i, 2).Resize(1, endPoint-1) = results(i)
        Next
    End With   
    Application.ScreenUpdating = True
End Sub

Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
    With ws
        GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row
    End With
End Function

结果:

results


关于GetInfo方法和CSS选择器的注释:

GetInfo的类方法使用css组合选择器从每个网页中提取信息以定位页面样式。

我们在每个页面上的信息都在两个相邻的表中,例如:

我只是使用tbody td的选择器组合来定位表体元素中的所有表格单元格,而不是使用多个表格。

CSS选择器组合通过querySelectorAllHTMLDocument方法应用,返回静态nodeList

返回的nodeList项目在偶数索引处具有标题,在奇数索引处具有所需数据。我只想要前两个信息表,所以我在返回的nodeList上终止循环,当我给出两倍感兴趣的标题长度时。我使用索引1的第2步循环来仅检索感兴趣的数据,减去标题。

返回的nodeList的样本:


参考文献(VBE>工具>参考文献):

  1. Microsoft HTML对象库

Alpha Vantage API:

快速查看time series API调用表明可以使用字符串

https://www.alphavantage.co/query?function=TIME_SERIES_DAILY&symbol=AA&outputsize=full&apikey=yourAPIKey

这会产生一个JSON响应,在整个返回字典的Time Series (Daily)子字典中,返回了199个日期。每个日期都有以下信息:

稍微深入一下文档将揭示是否可以捆绑代码,我无法快速看到这一点,以及是否可以通过不同的查询字符串获得更多您感兴趣的初始项目。

有更多信息,例如,在URL调用中使用TIME_SERIES_DAILY_ADJUSTED函数

https://www.alphavantage.co/query?function=TIME_SERIES_DAILY_ADJUSTED&symbol=AA&outputsize=full&apikey=yourAPIkey

在这里,您将获得以下内容:

您可以使用QSON解析器(如JSONConverter.bas)解析JSON响应,还有csv下载选项。

*值得做一些研究,了解哪些API可以提供最多的商品。 Alpha Vantage似乎没有覆盖我上面的代码检索的数量。


0
投票

这是一些光滑的代码!我很喜欢!!顺便说一句,你可能想考虑使用R来做这种事情。看看你可以用几行简单的代码做什么!

library(finreportr)

# print available functions in finreportr
ls('package:finreportr')

my.ticker <- 'SBUX'

# set final year
my.year <- 2017

# get income for FB
my.income <- GetIncome(my.ticker, my.year)

# print result
print(head(my.income))


# get unique fields
unique.fields <- unique(my.income$Metric)

# cut size of string
unique.fields <- substr(unique.fields,1, 60)

# print result
print(unique.fields)


# set col and date
my.col <- 'Earnings Per Share, Basic'

# print earnings per share
print(my.income[my.income$Metric == my.col, ])


library(tidyquant)

# set stock and dates
my.ticker <- 'AAPL'
first.date <- '2017-01-01'
last.date <-  Sys.Date()

# get data with tq_get
my.df <- tq_get(my.ticker,
                get = "stock.prices", 
                from = first.date, 
                to = last.date)

print(tail(my.df))


# get key financial rations of AAPL
df.key.ratios <- tq_get("AAPL",get = "key.ratios")

# print it
print(df.key.ratios) 
© www.soinside.com 2019 - 2024. All rights reserved.