Excel VBA Web源代碼-如何將多個字段提取到一張工作表

Question

大家下午好。 在對先前由QHarr解決的查詢進行的后續操作中，我想對源代碼中的多個字段（而不只是一個字段）運行已解決的查詢。

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

而采用'Previous Close'價'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

無論如何，理想情況下，每個字段都應位於用於股票的股票行情代碼的右側。

工作表的屏幕截圖：

任何幫助將不勝感激。
謝謝。

Answer 1

tl; dr;

以下代碼適用於給定的測試用例。 如果列表較長，請參閱“ ToDo部分。

API：

如果可能的話，您想研究提供此信息的API。 我相信Alpha Vantage現在可以提供Yahoo Finance API用於*的信息。 有一個很好的JS的教程在這里 。 這里有 Alpha Vantage文檔。 在此答案的最底端，我快速瀏覽了通過API可用的時間序列函數。

WEBSERVICE功能：

使用API​​密鑰，您還可以潛在地使用Excel中的Web服務功能來檢索和解析數據。 這里的例子。 _{未經測試。}

XMLHTTPRequest和類：

但是，我將向您展示一種使用類和URL循環的方法。 您可以對此進行改進。 我使用一個名為clsHTTP的簡單類來保存XMLHTTP請求對象。 我給它2種方法。 一個是GetHTMLDoc ，以在html文檔中返回請求響應，另一個是GetInfo ，以從頁面中返回感興趣項的數組。

以這種方式使用類意味着我們節省了重復創建和銷毀xmlhttp對象的開銷，並提供了一組很好的描述性公開方法來處理所需的任務。

假定您的數據如圖所示，標題行為第2行。

去做：

最明顯的發展是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

---

結果：

---

關於GetInfo方法和CSS選擇器的說明：

GetInfo的class方法使用css組合選擇器以頁面樣式為目標從每個網頁提取信息。

我們在每個頁面上獲取的信息位於兩個相鄰的表中，例如：

而不是搞亂多個表，我只是使用tbody td的選擇器組合定位表主體元素內的所有表單元格。

CSS選擇器組合通過HTMLDocument的querySelectorAll方法應用，返回一個靜態的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

在這里，您將獲得以下信息：

您可以使用諸如JSONConverter.bas之類的JSON解析器來解析JSON響應，並且還有csv下載的選項。

*值得研究哪些API提供了您項目的最大覆蓋范圍。 Alpha Vantage似乎沒有覆蓋我上面的代碼檢索的內容。

Answer 2

那是一些漂亮的代碼！ 我很喜歡！！ 順便說一句，您可能要考慮使用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)