html - VBA:从HTML表格中的TD的innerhtml中提取href的有效方法

Question

我正在从驻留在 HTML 表中的 TD 的 innerHTML 中提取 href。

使用的网址: http://www.moneycontrol.com/india/mutualfunds/mfinfo/portfolio_holdings/MMO029

有一个类tblporhd的表，我从中获取数据。我正在使用 MSXML2.XMLHTTP 对象从站点中提取该对象，并将其加载到 HTMLDocument 中，并且工作正常。我的疑问在于我使用的从表格中的一个单元格(TD)中提取 href 的方法。我将 innerHTML 传递给基于 RegExp 的 UDF，如下所示。

strGetURL(objCell.innerHTML)

功能如下(工作):

Private Function strGetURL(strInput As String) As String
Dim RgEx As Object: Set RgEx = CreateObject("VBScript.RegExp")
Dim objMatches As Object
With RgEx
    .MultiLine = False
    .Global = True
    .Pattern = "href=(["" '])(.*?)\1"
End With

Set objMatches = RgEx.Execute(strInput)
If objMatches.Count <> 0 Then
    strGetURL = Replace(objMatches.Item(0).submatches.Item(1), "about:/", "http://www.moneycontrol.com/")
Else
End If

End Function

查询:

虽然我的代码可以工作，但是否有任何方法可以通过使用某些默认功能/语法或已经可以在 HTMLDocument Table Cell 中处理的更好方法来获得相同的结果？

我已经搜索过互联网，但找不到任何相关代码，因此发布了一个新问题。如果需要任何其他信息，请告诉我。

Answer 1

希望能解决这个问题。立即尝试:

Sub TableData()
    Const base_url As String = "http://www.moneycontrol.com"
    Dim HTTP As New XMLHTTP60, html As New HTMLDocument
    Dim posts As Object, elem As Object, trow As Object

    With HTTP
        .Open "GET", "http://www.moneycontrol.com/india/mutualfunds/mfinfo/portfolio_holdings/MMO029", False
        .send
        html.body.innerHTML = .responseText
    End With

    Set posts = html.getElementsByClassName("tblporhd")(0)

    For Each elem In posts.getElementsByTagName("tr")
        For Each trow In elem.getElementsByTagName("td")
            With trow.getElementsByTagName("a")
                If .Length Then Cells(z + 1, 1) = base_url & Split(.Item(0).href, "about:")(1)
            End With
            y = y + 1: Cells(r + 1, y + 1) = trow.innerText
        Next trow
        y = 0
        r = r + 1
        z = z + 1
    Next elem
End Sub