GetElementByID（）VBA Excel无法正常工作 [英] GetElementByID() VBA Excel Not working

问题描述

我遇到了一个我无法解决的问题。我正在通过vba访问一个网站，并希望获得部件号的定价。当我单步执行它时，代码工作得很好，但是不能实时工作。

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.

我想说的是在每行按 F8 键逐行执行代码时代码执行正常但是我什么时候我要求它按 F5 执行代码错误
Debug.PrintInnerHTML& vbNewLine& ElementList.innerHTML ，错误代码424，自以来所需的对象Set ElementList = HTMLDoc.getElementById（Prce）返回一个空对象。

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.

我的代码

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 key。

URL = http://www.mcmaster.com/#91731A049

InnerHtml

< table class =PrceTierTbl>< ; tbody>< tr>< td class =PrceTierQtyColdata-mcm-prce-lvl =1> 1-9每个< / td>< td class =InLnOrdWebPartLayoutExpdView_prceLvlCell PrceTierPrceColdata-mcm-prce -lvl =1> $ 3.22< / td>< / tr>< tr>< td> class =PrceTierQtyColdata-mcm-prce-lvl =2> 10或更多< /吨d>< td class =InLnOrdWebPartLayoutExpdView_prceLvlCell PrceTierPrceColdata-mcm-prce-lvl =2> $ 2.56< / td>< / tr>< / tbody>< / table>

元素数量1

元素类名称= PrceTierTbl

ElementTableRows

InnerText @（0,0）= 1-9每个

InnerText @（0,1）= $ 3.22

InnerText @（1,0）= 10或更多

InnerText @（1,1）= $ 2.56

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

推荐答案

代码如下：

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。我已经添加了额外的检查目标节点是否已动态创建：

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

现在我的输出完全相同你期望的（不包括出现等待IE ......行）。

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

这篇关于GetElementByID（）VBA Excel无法正常工作的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！