从Intranet站点获取值

时间:2014-09-16 12:21:18

标签: excel

我正在尝试从内部页面获取值并将其复制到excel中的单元格。 我需要值572.74,但我似乎找不到它。 有人可以帮忙吗?

我无法发布完整的网站或链接,因为它在内部网上。

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 &#8364;</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

编辑:此解决方法适用于我 我找不到带有id的,但是选择然后搜索所有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

0 个答案:

没有答案