在VBA中通过嵌套标记名称获取getElement

时间:2016-12-28 07:59:15

标签: excel-vba vba excel

我想获取网页链接和嵌套标记的元素:

<a href='/cacti/graph.php?action=view&amp;local_graph_id=279&amp;rra_id=all'><img class='graphimage' id='graph_279' src='/cacti/graph_image.php?local_graph_id=279&amp;rra_id=0&amp;view_type=tree&amp;graph_start=1482822537&amp;graph_end=1482908937' border='0' alt='ARD-Besat-MKT450G  - Bandwidth 16 Mb- ether3-Link to PTMP'></a>

这是我的源代码的一部分。

最后我要:

cells(1,1).value="link address : /cacti/graph.php?action=view&amp;local_graph_id=279&amp;rra_id=all"

cells(1,2).value="image address: /cacti/graph_image.php?local_graph_id=279&amp;rra_id=0&amp;view_type=tree&amp;graph_start=1482822537&amp;graph_end=1482908937"

cells(1,3).value="image alt: ARD-Besat-MKT450G  - Bandwidth 16 Mb- ether3-Link to PTMP'

我在VBA中的功能是:

Function WebPageLinks(internet, tagname As String)
Dim internetdata As HTMLDocument
Dim internetlink As Object
Dim internetinnerlink As Object
Set internetdata = internet.document
Set internetlink = internetdata.getElementsByTagName(tagname)
For Each internetinnerlink In internetlink
Sheets("Sheet1").Select
Sheets(1).Cells(linkcount, 1) = internetinnerlink.href' true
Sheets(1).Cells(linkcount, 2) = internetinnerlink.innerhtml' true
Sheets(1).Cells(linkcount, 3) =internetinnerlink.src ' error
Sheets(1).Cells(linkcount, 4) = internetinnerlink.alt' error
linkcount = linkcount + 1
Next internetinnerlink
End Function`

1 个答案:

答案 0 :(得分:0)

Function WebPageLinks2(internet, tagname As String, innerlinkcount)

Dim td As MSHTML.IHTMLElementCollection
Dim tr As MSHTML.IHTMLElementCollection
Dim trObj As MSHTML.HTMLGenericElement
Dim tdObj As MSHTML.HTMLGenericElement
Dim flag As Boolean

flag = False

Set tr = internet.document.getElementsByTagName("a")
For Each trObj In tr
    Set td = trObj.getElementsByClassName("graphimage")
    For Each tdObj In td
        'do something with each td object'
         If (InStr(CStr(tdObj.alt), "Agg") <> 0) Or (InStr(CStr(tdObj.alt), "ether1") <> 0) Or (InStr(CStr(tdObj.alt), "Ether1") <> 0) Then
             Sheets(1).Cells(innerlinkcount, 7) = tdObj.src
             Sheets(1).Cells(innerlinkcount, 6) = tdObj.alt
             'Debug.Print tdObj.alt
             'Debug.Print tdObj.src
             flag = True
             Call SaveGraphImageFromURLs(Sheets(5).Cells(17, 3).Value, Sheets(1).Cells(innerlinkcount, 7).Value, _
             ToPathOfImages & "\" & Sheets(1).Cells(innerlinkcount, 1).Value & Sheets(1).Cells(innerlinkcount, 3).Value & Sheets(1).Cells(innerlinkcount, 6).Value & ".png", _
             Sheets(5).Cells(18, 3).Value, Sheets(5).Cells(19, 3).Value)
             Sheets(1).Hyperlinks.Add Range("g" & innerlinkcount), hyperlinkAddress
             Exit For
        End If
    Next
    If InStr(trObj.href, "xport") And flag Then
       Sheets(1).Cells(innerlinkcount, 5) = trObj.href
       flag = False
       Call SaveGraphImageFromURLs(Sheets(5).Cells(17, 3).Value, Sheets(1).Cells(innerlinkcount, 5).Value, _
       Sheets(5).Cells(20, 3).Value & Sheets(1).Cells(innerlinkcount, 1).Value & Sheets(1).Cells(innerlinkcount, 3).Value & Sheets(1).Cells(innerlinkcount, 6).Value & ".csv", _
       Sheets(5).Cells(18, 3).Value, Sheets(5).Cells(19, 3).Value)
       Call csvimport((Sheets(5).Cells(20, 3).Value))
       Call tahlil(innerlinkcount)
       Call move_files(CStr((Sheets(5).Cells(20, 3).Value)), CStr(ToPath))
       'Debug.Print trObj.href
       'Debug.Print " \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
       Exit For
    End If
Next

root = root + 1

End Function