2016-03-17 375 views
0

我有一個問題,我無法解決。我通過vba訪問網站,並希望獲得零件編號的定價。當我單步執行代碼時,代碼很有用,但不能實時運行。GetElementByID()VBA Excel不工作

什麼,我想說的是,當行按在每一行代碼執行罰款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> <TR> < TD類= 「PrceTierQtyCol」 數據-MCM-prce-LVL = 「1」 > 1-9每個</TD > < TD類= 「InLnOrdWebPartLayoutExpdView_prceLvlCell PrceTierPrceCol」 數據-MCM-prce-LVL = 「1」 > $ 3.22 </TD > </TR > <TR> <TD>類= 「PrceTierQtyCol」 數據-MCM-prce-LVL = 「2」 > 10以上</TD > < TD類= 「InLnOrdWebPartLayoutExpdView_prceLvlCell PrceTierPrceCol」 數據-MCM-prce-LVL = 「2」 > $ 2.56 </TD > </TR > </tbody的> < /表>
元件數1個
元素類名= PrceTierTbl
ElementTableRows
的innerText @(0,0)= 1-9每個
的innerText @(0,1)= $ 3.22
的innerText @(1,0)= 10個或更多
的innerText @(1,1)= $ 2.56

+0

您的修復工作正常。我將添加到代碼中以循環訪問excel中的數據。 – Ashok

回答

0

的代碼應如下所示:

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瀏覽器...」線)。