GetElementByID() VBA Excel 不工作

Posted 2023-03-24

【中文标题】GetElementByID() VBA Excel 不工作

【英文标题】：GetElementByID() VBA Excel Not working

【发布时间】：2016-07-04 07:40:01

【问题描述】：

我有一个我无法解决的问题。我正在通过 vba 访问一个网站，并希望获得零件号的定价。当我单步执行代码时，代码运行良好，但不能实时运行。

我想说的是，当通过在每一行上按 F8 键逐行执行代码时，代码执行良好，但是当我要求它通过按 F5 上的代码错误 Debug.Print "Innerhtml" & vbNewLine & ElementList.innerHTML 错误代码 424，需要对象，因为 Set ElementList = HTMLDoc.getElementById("Prce") 返回一个空对象。

我的代码

Sub GetPricingFromWeb()

    Dim IE As InternetExplorer
    Dim HTMLDoc As IHTMLDocument
    Dim Elements As IHTMLElementCollection
    Dim Element As IHTMLElement, ElementList As IHTMLElement
    Dim ElementTable As IHTMLTable
    Dim incrRow As Long, incrCol As Long, LoopBReak As Long
    Dim URL As String, strPN As String

    strPN = "91731A049"
    URL = "http://www.mcmaster.com/#" & strPN
    Debug.Print "URL = " & URL

    Set IE = New InternetExplorer

    With IE
        .navigate URL
        .Visible = False
        'Waiting till page loads
        Do While .readyState <> READYSTATE_COMPLETE
            DoEvents
            Debug.Print "Waiting on IE" & Time
        Loop

    End With

    Set HTMLDoc = IE.Document
    'Wait till document load is complete
    Do While HTMLDoc.readyState <> "complete"
        DoEvents
        Debug.Print "Waiting on document" & Time
    Loop

    If Not HTMLDoc Is Nothing Then
        Set ElementList = HTMLDoc.getElementById("Prce") ' <-- error code 424, object required
        Debug.Print "InnerHTML" & vbNewLine & ElementList.innerHTML
    End If
    If Not ElementList Is Nothing Then
        Set Elements = ElementList.Children
        Debug.Print "Number of elements " & Elements.Length
    Else
        GoTo SkipProcedure
    End If

    For Each Element In Elements

        Debug.Print "Element Class name = " & Element.className
        If Element.className = "PrceTierTbl" Then
            Set ElementTable = Element
            If Not ElementTable Is Nothing Then
                Debug.Print "ElementTableRows"
                For incrRow = 0 To ElementTable.Rows.Length - 1
                    For incrCol = 0 To ElementTable.Rows(incrRow).Cells.Length - 1
                        Debug.Print "InnerText @ (" & incrRow & "," &   incrCol & ") = " & ElementTable.Rows(incrRow).Cells(incrCol).innerText
                    Next incrCol
                Next incrRow
            End If
        End If
    Next

    IE.Quit

    Exit Sub

    SkipProcedure:
        MsgBox "nothing happened"
        IE.Quit
End Sub

代码的结果应该是 当您使用 F8 键单步执行时，结果应该是这样的。

网址 = http://www.mcmaster.com/#91731A049 内部HTML

1-9 个	$3.22
class="PrceTierQtyCol" data-mcm-prce-lvl="2">10 或更多	$2.56

元素数 1 元素类名 = PrceTierTbl 元素表行 InnerText @ (0,0) = 1-9 每个 内部文本 @ (0,1) = $3.22 InnerText @ (1,0) = 10 或更多 内部文本 @ (1,1) = $2.56

【问题讨论】：

您的修复正在运行。我将添加到代码中以循环遍历 excel 中的数据。

【参考方案1】：

代码应该如下：

Sub GetPricingFromWeb()

    Dim IE As InternetExplorer
    Dim HTMLDoc As IHTMLDocument
    Dim Elements As IHTMLElementCollection
    Dim Element As IHTMLElement, ElementList As IHTMLElement
    Dim ElementTable As IHTMLTable
    Dim incrRow As Long, incrCol As Long, LoopBReak As Long
    Dim URL As String, strPN As String

    strPN = "91731A049"
    URL = "http://www.mcmaster.com/#" & strPN
    Debug.Print "URL = " & URL

    Set IE = New InternetExplorer

    With IE
        .navigate URL
        .Visible = False
        'Waiting till page loads
        Do While .readyState <> READYSTATE_COMPLETE
            DoEvents
            Debug.Print "Waiting on IE" & Time
        Loop

    End With

    Set HTMLDoc = IE.Document
    'Wait till document load is complete
    Do While HTMLDoc.readyState <> "complete"
        DoEvents
        Debug.Print "Waiting on document" & Time
    Loop

    Do While IsNull(HTMLDoc.getElementById("Prce")): DoEvents: Loop

    If Not HTMLDoc Is Nothing Then
        Set ElementList = HTMLDoc.getElementById("Prce") ' <-- error code 424, object required
        Debug.Print "InnerHTML" & vbNewLine & ElementList.innerHTML
    End If
    If Not ElementList Is Nothing Then
        Set Elements = ElementList.Children
        Debug.Print "Number of elements " & Elements.Length
    Else
        GoTo SkipProcedure
    End If

    For Each Element In Elements

        Debug.Print "Element Class name = " & Element.className
        If Element.className = "PrceTierTbl" Then
            Set ElementTable = Element
            If Not ElementTable Is Nothing Then
                Debug.Print "ElementTableRows"
                For incrRow = 0 To ElementTable.Rows.Length - 1
                    For incrCol = 0 To ElementTable.Rows(incrRow).Cells.Length - 1
                        Debug.Print "InnerText @ (" & incrRow & "," & incrCol & ") = " & ElementTable.Rows(incrRow).Cells(incrCol).innerText
                    Next incrCol
                Next incrRow
            End If
        End If
    Next

    IE.Quit

    Exit Sub

SkipProcedure:
        MsgBox "nothing happened"
        IE.Quit
End Sub

它看起来像 DHTML。如果目标节点是动态创建的，我添加了额外的检查：

Do While IsNull(HTMLDoc.getElementById("Prce")): DoEvents: Loop

现在我的输出与您预期的完全相同（不包括出现的“Waiting on IE ...”行）。