GetElementByID() VBA Excel Not working

2019-08-15 05:16发布

问题:

I have a problem that I am unable to address. I am accessing a website through vba and want to get pricing for a part number. The code works great when I step through it, but does not work in real time.

What I am trying to say is when execute code line by line by pressing F8 key on every line the code executes fine, but I when I ask it to execute by pressing F5 the code errors on Debug.Print "InnerHTML" & vbNewLine & ElementList.innerHTML with error code 424, object required since Set ElementList = HTMLDoc.getElementById("Prce") is returning an empty object.

My Code

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

Result of code should be The result should be this when you step through using F8 key.

URL = http://www.mcmaster.com/#91731A049
InnerHtml
<table class="PrceTierTbl"><tbody><tr><td class="PrceTierQtyCol" data-mcm-prce-lvl="1">1-9 Each</td><td class="InLnOrdWebPartLayoutExpdView_prceLvlCell PrceTierPrceCol" data-mcm-prce-lvl="1">$3.22</td></tr><tr><td >class="PrceTierQtyCol" data-mcm-prce-lvl="2">10 or more</td><td class="InLnOrdWebPartLayoutExpdView_prceLvlCell PrceTierPrceCol" data-mcm-prce-lvl="2">$2.56</td></tr></tbody></table>
Number of elements 1
Element Class name = PrceTierTbl
ElementTableRows
InnerText @ (0,0) = 1-9 Each
InnerText @ (0,1) = $3.22
InnerText @ (1,0) = 10 or more
InnerText @ (1,1) = $2.56

回答1:

The code should be as follows:

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

It looks like DHTML. I've added additional check if the target node has been created dynamically:

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

Now I have exactly the same output as you expected (excluding appeared "Waiting on IE ..." lines).