从内部网站获取一个值

我试图从内部页面获取一个值，并将其复制到Excel中的单元格。 我需要价值572.74，但我似乎无法find它。 谁能帮忙？

我不能发布完整的网站或链接，因为它是在内部网上。

部分的html网站：

<!-- PP3 est. volume --> <tr> <td class="header tab1"><span class='tooltip' id='tt5417eb47bed97'>PP3 est.<br>volume</span></td> <td class="right">572.74 €</td> <td class="left">(100%)</td> <td class="left"> <a class="button nyroModal" target="_blank" id="cogprognoseeditmodal" href="/part/prognose/edit/id/4022.623.39561" title=""><img src='/images/table_edit.png'></a> </td> <td class="small italic">(320517@2014-09-16 05:16:42)</td> </tr> 

码：

 Private Sub CommandButton2_Click() Dim pp3 As String Dim Ieapp As Object Dim oShell As Object Dim Wnd As Object Dim hwnd As Long Set Ieapp = CreateObject("InternetExplorer.Application") With Ieapp hwnd = .hwnd .Navigate "intranet site" End With Set oShell = CreateObject("Shell.Application") For Each Wnd In oShell.Windows If hwnd = Wnd.hwnd Then Set Ieapp = Wnd Next Wnd Do Until Ieapp.ReadyState = 4 DoEvents Loop Do Until Ieapp.ReadyState = 4 DoEvents Loop Set Doc = CreateObject("htmlfile") Set Doc = Ieapp.document 'plug in some value pp3 = Doc.getElementById("tt5417eb47bed97").getElementsByClassName("right").Item(0).Innertext ActiveSheet.Range("D1") = pp3 Ieapp.Visible = True Set oShell = Nothing Set Ieapp = Nothing End Sub 

编辑：这个解决方法为我工作我无法find一个ID，但select，然后search所有TD

 Set Table = Doc.getelementbyid("attributesTab-frag-1") Set TDelements = Table.getElementsByTagName("TD") r = 0 For Each TDelement In TDelements 'Look for required TD elements - this check is specific to VBA Express forum - modify as required If TDelement.className = "right" Or TDelement.className = "right " Then Select Case r Case 0 Scell.Offset(0, -1).Value = TDelement.innerText Case 1 Scell.Offset(0, 0).Value = TDelement.innerText Case 2 Scell.Offset(0, 1).Value = TDelement.innerText Case 4 Scell.Offset(0, 2).Value = TDelement.innerText Case 5 Scell.Offset(0, 3).Value = TDelement.innerText Case 6 Scell.Offset(0, 4).Value = TDelement.innerText Case 7 Scell.Offset(0, 5).Value = TDelement.innerText End Select r = r + 1 End If Next