如何使用VBA从img获取alt值 [英] How to fetch the alt value from an img using vba

问题描述

我正试图从为此，我有以下代码:

一切正常，只显示最后一列的img alt标签.仅不获取最后一列的类，此代码才能很好地工作.

Everything is working fine only the img alt tag of the last column is not displaying in the. This code is perfectly fine only the last column's class is not fetched.

Sub TableExample()

Dim IE As Object
Dim doc As Object
Dim strURL As String

    If Range("B2").Value <> "NA" Then
        strURL = "http://www.idealo.co.uk/compare/351072/canon-500d-77mm-close-up-lens.html"
        Set IE = CreateObject("InternetExplorer.Application")
        With IE
            '.Visible = True
            .navigate strURL
            Do Until .readyState = 4: DoEvents: Loop
            Do While .Busy: DoEvents: Loop
            Set doc = IE.document
            GetAllTables doc
            .Quit
        End With
    End If

End Sub

Sub GetAllTables(doc As Object)

    Dim ws As Worksheet
    Dim rng As Range
    Dim tbl As Object
    Dim rw As Object
    Dim cl As Object
    Dim tabno As Long
    Dim nextrow As Long
    Dim i As Long

    Set ws = Sheets("Sheet1")

    For Each tbl In doc.getElementsByTagName("TABLE")
        tabno = tabno + 1
        nextrow = nextrow + 1
        Set rng = ws.Range("B" & nextrow)
        rng.Offset(, -1) = "Table " & tabno
        On Error GoTo Err1:
        If tabno = 10 Then
            For Each rw In tbl.Rows
                colno = 6
                For Each cl In rw.Cells
                    If colno = 6 And nextrow > 10 Then
                        Set classColl = doc.getElementsByClassName("cellborder")
                        Set imgTgt = classColl(nextrow - 11).getElementsByTagName("img")
                        rng.Value = imgTgt(0).getAttribute("alt")
                    Else
                        rng.Value = cl.innerText
                    End If
                    Set rng = rng.Offset(, 1)
                    i = i + 1
                    colno = colno + 1
                Next cl
                nextrow = nextrow + 1
                Set rng = rng.Offset(1, -i)
                '     Call trim1
                i = 0
            Next rw
            Exit Sub
        End If
    Next tbl

Err1:
'Call comp
'    ws.Cells.ClearFormats
End Sub

推荐答案

为您的GetAllTables子例程尝试以下(非常脏)的变体:

Try this (very dirty) variation for your GetAllTables subroutine:

Sub GetAllTables(doc As Object)

    Dim ws As Worksheet
    Dim rng As Range
    Dim tbl As Object
    Dim rw As Object
    Dim cl As Object
    Dim tabno As Long
    Dim nextrow As Long
    Dim i As Long

    Set ws = Sheets("Sheet1")

    'Improvised way of getting images.
    Dim imagesColl As New Collection
    Set imgColl = doc.getElementsByClassName("noborder")
    For Each imgElem In imgColl
        If imgElem.getAttribute("height") = 30 And imgElem.getAttribute("width") = 80 Then
            imagesColl.Add imgElem.getAttribute("alt")
        End If
    Next imgElem

    For Each tbl In doc.getElementsByTagName("table")
        tabno = tabno + 1
        If tabno = 10 Then
            nextrow = 1
            imgIter = 1
            For Each rw In tbl.Rows
                colno = 1
                For Each cl In rw.Cells
                    Set rng = ws.Cells(nextrow, colno)
                    If colno = 5 Then
                        rng.Value = imagesColl.Item(imgIter)
                        imgIter = imgIter + 1
                    Else
                        rng.Value = cl.innerText
                    End If
                    colno = colno + 1
                Next cl
                nextrow = nextrow + 1
            Next rw
            Exit Sub
        End If
    Next tbl

End Sub

事情是，您实际上不必做表格样式.如果您知道要定位的元素，那么为DOM以外的数据创建一个集合(即使用 normal VBA集合)会更好，恕我直言.

Thing is, you don't really have to do it table style. If you know which elements to target, creating a collection for the data outside of the DOM (that is, using normal VBA collections) is much better IMHO.

无论如何，上面是 经过测试并 .让我们知道是否有帮助.

Anyway, above is tried and tested. Let us know if this helps.

这篇关于如何使用VBA从img获取alt值的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！