将网页内容复制到字符串

Question

我需要访问网页并将其内容（所有内容）复制到一个字符串中，然后从中提取一些数字。

网页地址每次都会变化，因为我基本上是在访问一个在线模拟工具，我每次都必须指定模拟参数。并且输出始终是一个大约 320 个字符的字符串。该网页仅包含该文本。

网址/查询示例：

http://re.jrc.ec.europa.eu/pvgis5/PVcalc.php?lat=45&lon=8&peakpower=1&loss=14&optimalangles=1&outputformat=basic

网页内容示例（要检索的字符串）： 37 0 1 54.9 72.1 7.21 2 73.1 96.0 12.0 12.0 3 114 149 15.5 4 121 160 17.9 5 140 185 185 11.3 6 142 188 9.31 7 161 212 212 10.2 8 149 197 197 197 10.0 55.8 73.2 9.47 年 1270 1680 58.8 AOI 损失：2.7% 光谱影响：- 温度和低辐照度损失：8.0% 综合损失：24.1%

给你的问题

有没有一种方法可以复制该字符串而不必每次都打开和关闭浏览器？当我运行我的分析时，我必须重复该操作（确定查询参数，检索相关字符串，从字符串中提取我需要的值）总共 7200 次，我想要它尽可能流畅和快速。

注意：我不需要将字符串文本保存在文档中，但如果需要，可以这样做，然后打开文件并检索我的字符串。但这听起来效率太低了，我相信一定有更好的方法！

Answer 1

有了这么多的请求，最好使用一个类来保存 xmlhttp 对象，而不是使用一个函数（您每次都在其中创建和销毁该对象）。然后运行一个将所有 url 传递给该对象的子程序。为类提供返回字符串的方法。

类模块：clsHTTP

Option Explicit  
Private http As Object

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

Public Function GetString(ByVal url As String) As String
    Dim sResponse As String
    With http
        .Open "GET", url, False
        .send
        GetString = .responseText
    End With
End Function

标准模块 1：

Option Explicit 
Public Sub GetStrings()
    Dim urls, ws As Worksheet, i As Long, http As clsHTTP
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set http = New clsHTTP
    'read in from sheet the urls
    urls = Application.Transpose(ws.Range("A1:A2").Value) 'Alter range to get all urls
    Application.ScreenUpdating = False
    For i = LBound(urls) To UBound(urls)
        ws.Cells(i, 2) = http.GetString(urls(i))
    Next
    Application.ScreenUpdating = True
End Sub

Answer 2

我经常使用下面的函数变体来处理诸如从网页中提取 html 或通过查询 API 得到 JSON 结果等等。

---

后期版本

这个“独立”版本不需要参考：

Public Function getHTTP(ByVal url As String) As String
'returns HTML from URL (works on *almost* any URL you throw at it)
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url, False
        .Send
        getHTTP = StrConv(.responseBody, vbUnicode)
    End With
End Function

---

早订版

如果您要访问多个网站，则改用此版本会更高效（速度提高两倍，并且更容易占用系统资源）。您需要添加对 MS XML 库的引用（Tools → References → Microsoft XML, v6.0）。

Public Function getHTTP(ByVal url As String) As String  
'Returns HTML from a URL, early bound (requires reference to MS XML6)
    Dim msXML As New XMLHTTP60
    With msXML
        .Open "GET", url, False
        .Send
        getHTTP = StrConv(.responseBody, vbUnicode)
    End With
    Set msXML = Nothing
End Function

---

只返回文本

当使用上述函数调用网页时，它们将返回原始 HTML 源代码。您可以剥离 HTML 标记，只留下带有来自Tim Williams 的这个漂亮功能的页面的“纯文本”版本：

Function HtmlToText(sHTML) As String
'requires reference: Tools → References → "Microsoft HTML Object Library"
    Dim oDoc As HTMLDocument
    Set oDoc = New HTMLDocument
    oDoc.body.innerHTML = sHTML
    HtmlToText = oDoc.body.innerText
End Function

---

示例：

综合起来，下面的例子返回“this”网页的纯文本。

Option Explicit
'requires reference: Tools > References > "Microsoft HTML Object Library"

Function HtmlToText(sHTML) As String
    Dim oDoc As HTMLDocument
    Set oDoc = New HTMLDocument
    oDoc.body.innerHTML = sHTML
    HtmlToText = oDoc.body.innerText
End Function

Public Function getHTTP(ByVal url As String) As String
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url, False
        .Send
        getHTTP = StrConv(.responseBody, vbUnicode)
    End With
End Function

Sub Demo()
    Const url = "https://stackoverflow.com/questions/54670251"
    Dim html As String, txt As String

    html = getHTTP(url)
    txt = HtmlToText(html)

    Debug.Print txt & vbLf  'Hit CTRL+G to view output in Immediate Window
    Debug.Print "HTML source = " & Len(html) & " bytes"
    Debug.Print "Plain Text  = " & Len(txt) & " bytes"
End Sub

---

更多信息：

• 编码就是爱：XmlHttpRequest – Http requests in Excel VBA

• 编码就是爱：Parse HTML in Excel VBA

• 编码就是爱：Import Json ⇄ Excel（使用VBA-JSON）

• 微软文档：Microsoft HTML Object Library

• 微软文档：Internet Explorer for Developers

• 微软文档：open Method (IXMLHTTPRequest)

Answer 3

是的，有一种方法可以在不使用 Internet Explorer 的情况下执行此操作，您可以使用 Web 请求。

这是一个示例方法。基本上，您正在模拟浏览器和服务器之间通常发生的通信。

Option Explicit

Public Function getPageText(url As String)
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url
        .send
        getPageText = .responseText
    End With
End Function

Sub Example()
    Dim url As String: url = "http://re.jrc.ec.europa.eu/pvgis5/PVcalc.php?lat=45&lon=8&peakpower=1&loss=14&optimalangles=1&outputformat=basic"
    Debug.Print getPageText(url)
End Sub