将网页内容复制到字符串
Copy web-page content to a string
我需要访问网页并将其内容（所有内容）复制到一个字符串中，然后我将从中提取一些数字。
网页地址每次都不一样，因为我基本上是访问在线模拟工具，每次都必须指定sim参数。并且输出始终是大约 320 个字符的字符串。该网页仅包含该文本。
网址/查询示例：
网页内容示例（要检索的字符串）：
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 11.3 6 6 142 188 9.31 7 161 212 10.2 849 197 197 197 197 10.0 13.5 12 55.8 73.2 9.47 年 1270 1680 58.8 AOI 损失：2.7% 光谱效应：- 温度和低辐照度损失：8.0% 综合损失：24.1%
问题给你
有没有一种方法可以复制该字符串而不必每次都打开和关闭浏览器？我必须重复该操作（确定查询参数，检索相关字符串，从字符串中提取我需要的值）总共 7200 次 当我 运行 我的分析，我希望它尽可能流畅和快速。
注意：我不一定需要将字符串文本保存在文档中，但如果需要，这样做就可以了，然后打开文件并检索我的细绳。但这听起来效率很低，我相信一定有更好的方法！
是的，有一种方法可以在不使用 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
有了这个数量的请求，最好使用 class 来保存 xmlhttp 对象，而不是使用函数（每次都在其中创建和销毁对象）。然后 运行 一个将所有 url 传递给该对象的 sub。为 class 提供 return 字符串的方法。
Class 模块：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
我经常使用 下面的函数变体 用于从网页中提取 html 或 JSON 查询 API 的结果，等等。
后期装订版本
此 "stand-alone" 版本 不需要引用 :
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
仅返回文本
使用上述函数调用网页时，会return原始HTML源代码。您可以 剥离 HTML 标签 并只留下 a e "plain text" 版本的页面，使用来自 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
示例：
放在一起，下面的例子return是"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 = ""
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
更多信息：
编码就是爱：Parse HTML in Excel VBA
编码就是爱：Import Json ⇄ Excel (Uses VBA-JSON)
我需要访问网页并将其内容（所有内容）复制到一个字符串中，然后我将从中提取一些数字。
网页地址每次都不一样，因为我基本上是访问在线模拟工具，每次都必须指定sim参数。并且输出始终是大约 320 个字符的字符串。该网页仅包含该文本。
网址/查询示例：
网页内容示例（要检索的字符串）： 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 11.3 6 6 142 188 9.31 7 161 212 10.2 849 197 197 197 197 10.0 13.5 12 55.8 73.2 9.47 年 1270 1680 58.8 AOI 损失：2.7% 光谱效应：- 温度和低辐照度损失：8.0% 综合损失：24.1%
问题给你
有没有一种方法可以复制该字符串而不必每次都打开和关闭浏览器？我必须重复该操作（确定查询参数，检索相关字符串，从字符串中提取我需要的值）总共 7200 次 当我 运行 我的分析，我希望它尽可能流畅和快速。
注意：我不一定需要将字符串文本保存在文档中，但如果需要，这样做就可以了，然后打开文件并检索我的细绳。但这听起来效率很低，我相信一定有更好的方法！
是的，有一种方法可以在不使用 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
有了这个数量的请求，最好使用 class 来保存 xmlhttp 对象，而不是使用函数（每次都在其中创建和销毁对象）。然后 运行 一个将所有 url 传递给该对象的 sub。为 class 提供 return 字符串的方法。
Class 模块：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
我经常使用 下面的函数变体 用于从网页中提取 html 或 JSON 查询 API 的结果，等等。
后期装订版本
此 "stand-alone" 版本 不需要引用 :
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
仅返回文本
使用上述函数调用网页时，会return原始HTML源代码。您可以 剥离 HTML 标签 并只留下 a e "plain text" 版本的页面，使用来自 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
示例：
放在一起，下面的例子return是"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 = ""
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
更多信息：
编码就是爱：Parse HTML in Excel VBA
编码就是爱：Import Json ⇄ Excel (Uses
VBA-JSON)