时间戳

首页 > 解决方案 > 使用Excel VBA加载IE11不兼容的网站

excel - 使用Excel VBA加载IE11不兼容的网站

问题描述

在 Excel VBA 中加载网站并将其放入工作表中，我一直在使用以下内容：

Dim IE As Object  
Set IE = CreateObject("InternetExplorer.Application")  
IE .navigate "https://www.wsj.com/market-data/bonds/treasuries"

然后我可以将其复制并粘贴到我的 Excel 工作表中。但是这个网站不再使用 IE11，而且 Excel VBA 坚持使用 IE11，即使它即将被弃用。

还有其他方法吗？我也看过：

肯定有一种简单的方法可以将网站或网站内的表格加载到 Excel 工作表中吗？这一定是一个很好的路径，但经过多次谷歌搜索后，我找不到一个真正有效的简单解决方案。

我有 5-10 个网页被加载到这本工作簿中，这似乎是一项全职工作，让整个工作正常进行！任何想法/帮助非常感谢！！！

标签： excelvbaseleniuminternet-explorer-11autoit

解决方案

与克里斯托弗在使用正则表达式时的回答类似的想法。我正在获取仪器数据（JS 数组），将组件字典拆分出来（减去 end }），然后使用基于标题的正则表达式来获取适当的值。

我使用字典来处理输入/输出标头，并设置几个请求标头以帮助发出基于浏览器的请求并减轻缓存结果的服务。

理想情况下，可以使用 html 解析器并获取script标签，然后在标签内的 JavaScript 对象上使用 json 解析器script。

如果您想要其他选项卡式结果中的数据，我可以通过显式设置添加它re.Global = True，然后循环返回的匹配项。取决于您是否想要这些以及您希望它们如何出现在工作表中。

我目前将结果写到一张名为Treasury Notes & Bonds.

Option Explicit

Public Sub GetTradeData()
    Dim s As String, http As MSXML2.XMLHTTP60 'required reference Microsoft XML v6,
    
    Set http = New MSXML2.XMLHTTP60

    With http
        .Open "GET", "https://www.wsj.com/market-data/bonds/treasuries", False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        s = .responseText
    End With
    
    Dim re As VBScript_RegExp_55.RegExp 'required reference Microsoft VBScript Regular Expressions
    
    Set re = New VBScript_RegExp_55.RegExp
    re.Pattern = "instruments"":\[(.*?)\]"
    s = re.Execute(s)(0).SubMatches(0)
    
    Dim headers() As Variant, r As Long, c As Long, mappingDict As Scripting.Dictionary 'required reference Microsoft Scripting Runtime
    
    Set mappingDict = New Scripting.Dictionary
    mappingDict.Add "maturityDate", "MATURITY"
    mappingDict.Add "coupon", "COUPON"
    mappingDict.Add "bid", "BID"
    mappingDict.Add "ask", "ASKED"
    mappingDict.Add "change", "CHG"
    mappingDict.Add "askYield", "ASKED YIELD"
    
    headers = mappingDict.keys
    
    Dim results() As String, output() As Variant, key As Variant
    
    results = Split(s, "}")
    ReDim output(1 To UBound(results), 1 To UBound(headers) + 1)
    
    For r = LBound(results) To UBound(results) - 1
        c = 1
        For Each key In mappingDict.keys
            re.Pattern = "" & key & """:""(.*?)"""
            output(r + 1, c) = re.Execute(results(r))(0).SubMatches(0)
            c = c + 1
        Next
    Next
    
    re.Pattern = "timestamp"":""(.*?)"""
    re.Global = True
    
    With ThisWorkbook.Worksheets("Treasury Notes & Bonds")
        
        .UsedRange.ClearContents
        
         Dim matches As VBScript_RegExp_55.MatchCollection
         
         Set matches = re.Execute(http.responseText)
        .Cells(1, 1) = matches(matches.Count - 1).SubMatches(0)
        .Cells(2, 1).Resize(1, UBound(headers) + 1) = headers
        .Cells(3, 1).Resize(UBound(output, 1), UBound(output, 2)) = output
    End With
End Sub

推荐阅读