GetElementByID() VBA Excel Не работает

Question

У меня есть проблема, с которой я не могу связаться. Я обращаюсь к веб-сайту через 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 ключ.

URL = http://www.mcmaster.com/#91731A049
InnerHtml
< Таблица классов = "PrceTierTbl" > < <TBODY> > тр < тд класс = "PrceTierQtyCol" данные-MCM-prce-лвл = "1" > 1-9 Каждый </тд > < тд класс = "InLnOrdWebPartLayoutExpdView_prceLvlCell PrceTierPrceCol" данные-MCM-prce-лвл = "1" > $ 3.22 </TD > </тр > < тр > < тд > класс = "PrceTierQtyCol" данные-MCM-prce-лвл = "2" > 10 или более </тд > < тд класс = "InLnOrdWebPartLayoutExpdView_prceLvlCell PrceTierPrceCol" Данные-MCM-prce-лвл = "2" > $ 2.56 </TD > </тр > </TBODY > </таблица >
Количество элементов 1 название
Элемент Класс = PrceTierTbl
ElementTableRows
InnerText @ (0,0) = 1-9 Каждый
InnerText @ (0,1) = $ 3.22
InnerText @ (1,0) = 10 или более
InnerText @ (1,1) = $ 2,56

Answer 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 TypeName(HTMLDoc.getElementById("Prce")) = "Null": 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 TypeName(HTMLDoc.getElementById("Prce")) = "Null": DoEvents: Loop 

Теперь у меня есть точно такой же результат, как вы ожидали (за исключением появилось «Ожидание IE ...» линия).