क्लासनाम द्वारा डेटा स्क्रैपिंग तत्व

Question 1

मैं एक वेब साइट से डेटा खींचने की कोशिश कर रहा हूँ, मैं पंक्ति 1 में '10' x 5'unit (वर्ग का नाम "unit_size मध्यम" है) की प्रतिलिपि बनाना चाहता हूं जिसके लिए मैं डेटा को सफलतापूर्वक कॉपी करने में सक्षम हूं लेकिन मैं भी चाहता हूं प्रोमो (कक्षा का नाम "promo_offers" है) 'पहला महीना मुफ़्त!' पंक्ति 2 में, समस्या यह है कि यह प्रोमो केवल विशिष्ट कोशिकाओं के लिए दिया जाता है। इसलिए डेटा भ्रामक है और मुझे पहले 4 सेल में प्रोमो मिल रहा है और फिर त्रुटि हो रही है। हालांकि, मैं केवल उन इकाइयों के लिए प्रोमो कॉपी करना चाहता हूं जहां प्रोमो की जानकारी दी गई है अन्यथा सेल खाली होनी चाहिए या कोई अन्य मूल्य निर्धारित करने की आवश्यकता है। नीचे कोड है ...

कृपया सुझाव दें कि कोड को कैसे फ्रेम करें।

Sub GetClassNames()

    Dim html As HTMLDocument

    Dim objIE As Object
    Dim element As IHTMLElement
    Dim ie As InternetExplorer
    Dim elements As IHTMLElementCollection
    Dim result As String 'string variable that will hold our result link

    Dim count As Long
    Dim erow As Long

    'initiating a new instance of Internet Explorer and asigning it to objIE
    Set objIE = New InternetExplorer

    'make IE browser visible (False would allow IE to run in the background)
    objIE.Visible = True

    'navigate IE to this web page (a pretty neat search engine really)
    objIE.navigate "https://www.allstorageonline.com/storage-units/texas/amarillo/all-storage-hardy-115423/#utm_source=GoogleLocal&utm_medium=WWLocal&utm_campaign=115423"

    'wait here a few seconds while the browser is busy
    Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
    count = 0

    Set html = objIE.document
    Set elements = html.getElementsByClassName("unit_size medium")

    For Each element In elements
        If element.className = "unit_size medium" Then
            erow = Sheet2.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Row
            Cells(erow, 1) = html.getElementsByClassName("unit_size medium")(count).innerText

            Cells(erow, 2) = html.getElementsByClassName("promo_offers")(count).innerText
            count = count + 1      
        End If
    Next element
End Sub

html excel vba web-scraping

1

kiran mamalwad 22 फरवरी 2019, 11:05

Answer

तत्व तक पहुंचने का प्रयास करते समय मैं बस On Error Resume Next में लपेटूंगा। आउटपुट ऐरे में इसके लिए पहले से ही एक जगह आरक्षित रखें ताकि यदि मौजूद न हो तो जगह खाली रहती है।

Option Explicit
'VBE > Tools > References:
' Microsoft Internet Controls
Public Sub GetData()
    Dim ie As New InternetExplorer, ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    With ie
        .Visible = True
        .Navigate2 "https://www.allstorageonline.com/storage-units/texas/amarillo/all-storage-hardy-115423/#utm_source=GoogleLocal&utm_medium=WWLocal&utm_campaign=115423"

        While .Busy Or .readyState < 4: DoEvents: Wend

        Dim listings As Object, listing As Object, headers(), results(), r As Long, c As Long
        headers = Array("size", "features", "promo", "in store", "web")
        Set listings = .document.getElementById("small_units_accordion_panel").getElementsByTagName("li")
        '.unit_size medium, .features, .promo_offers, .board_rate_wrapper p, .board_rate

        ReDim results(1 To listings.Length, 1 To UBound(headers) + 1)
        For Each listing In listings
            r = r + 1
            On Error Resume Next
            results(r, 1) = listing.getElementsByClassName("unit_size medium")(0).innerText
            results(r, 2) = listing.getElementsByClassName("features")(0).innerText
            results(r, 3) = listing.getElementsByClassName("promo_offers")(0).innerText
            results(r, 4) = listing.getElementsByClassName("board_rate")(0).innerText
            results(r, 5) = listing.getElementsByClassName("price")(0).innerText
            On Error GoTo 0
        Next
        ws.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        ws.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
        .Quit
    End With
End Sub

सभी बॉक्स:

Option Explicit

'VBE > Tools > References:
' Microsoft Internet Controls
Public Sub GetData()
    Dim ie As New InternetExplorer, ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    With ie
        .Visible = True
        .Navigate2 "https://www.allstorageonline.com/storage-units/texas/amarillo/all-storage-hardy-115423/#utm_source=GoogleLocal&utm_medium=WWLocal&utm_campaign=115423"

        While .Busy Or .readyState < 4: DoEvents: Wend

        Dim listings As Object, listing As Object, headers(), results()
        Dim r As Long, list As Object, item As Object
        headers = Array("size", "features", "promo", "in store", "web")
        Set list = .document.getElementsByClassName("main_unit")
        '.unit_size medium, .features, .promo_offers, .board_rate_wrapper p, .board_rate
        Dim rowCount As Long
        rowCount = .document.querySelectorAll(".main_unit li").Length
        ReDim results(1 To rowCount, 1 To UBound(headers) + 1)
        For Each listing In list
            For Each item In listing.getElementsByTagName("li")
                r = r + 1
                On Error Resume Next
                results(r, 1) = item.getElementsByClassName("unit_size medium")(0).innerText
                results(r, 2) = item.getElementsByClassName("features")(0).innerText
                results(r, 3) = item.getElementsByClassName("promo_offers")(0).innerText
                results(r, 4) = item.getElementsByClassName("board_rate")(0).innerText
                results(r, 5) = item.getElementsByClassName("price")(0).innerText
                On Error GoTo 0
            Next
        Next
        ws.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        ws.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
        .Quit
    End With
End Sub

2

QHarr 22 फरवरी 2019, 15:08

Question 2

तत्व तक पहुंचने का प्रयास करते समय मैं बस On Error Resume Next में लपेटूंगा। आउटपुट ऐरे में इसके लिए पहले से ही एक जगह आरक्षित रखें ताकि यदि मौजूद न हो तो जगह खाली रहती है।

Option Explicit
'VBE > Tools > References:
' Microsoft Internet Controls
Public Sub GetData()
    Dim ie As New InternetExplorer, ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    With ie
        .Visible = True
        .Navigate2 "https://www.allstorageonline.com/storage-units/texas/amarillo/all-storage-hardy-115423/#utm_source=GoogleLocal&utm_medium=WWLocal&utm_campaign=115423"

        While .Busy Or .readyState < 4: DoEvents: Wend

        Dim listings As Object, listing As Object, headers(), results(), r As Long, c As Long
        headers = Array("size", "features", "promo", "in store", "web")
        Set listings = .document.getElementById("small_units_accordion_panel").getElementsByTagName("li")
        '.unit_size medium, .features, .promo_offers, .board_rate_wrapper p, .board_rate

        ReDim results(1 To listings.Length, 1 To UBound(headers) + 1)
        For Each listing In listings
            r = r + 1
            On Error Resume Next
            results(r, 1) = listing.getElementsByClassName("unit_size medium")(0).innerText
            results(r, 2) = listing.getElementsByClassName("features")(0).innerText
            results(r, 3) = listing.getElementsByClassName("promo_offers")(0).innerText
            results(r, 4) = listing.getElementsByClassName("board_rate")(0).innerText
            results(r, 5) = listing.getElementsByClassName("price")(0).innerText
            On Error GoTo 0
        Next
        ws.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        ws.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
        .Quit
    End With
End Sub

सभी बॉक्स:

Option Explicit

'VBE > Tools > References:
' Microsoft Internet Controls
Public Sub GetData()
    Dim ie As New InternetExplorer, ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    With ie
        .Visible = True
        .Navigate2 "https://www.allstorageonline.com/storage-units/texas/amarillo/all-storage-hardy-115423/#utm_source=GoogleLocal&utm_medium=WWLocal&utm_campaign=115423"

        While .Busy Or .readyState < 4: DoEvents: Wend

        Dim listings As Object, listing As Object, headers(), results()
        Dim r As Long, list As Object, item As Object
        headers = Array("size", "features", "promo", "in store", "web")
        Set list = .document.getElementsByClassName("main_unit")
        '.unit_size medium, .features, .promo_offers, .board_rate_wrapper p, .board_rate
        Dim rowCount As Long
        rowCount = .document.querySelectorAll(".main_unit li").Length
        ReDim results(1 To rowCount, 1 To UBound(headers) + 1)
        For Each listing In list
            For Each item In listing.getElementsByTagName("li")
                r = r + 1
                On Error Resume Next
                results(r, 1) = item.getElementsByClassName("unit_size medium")(0).innerText
                results(r, 2) = item.getElementsByClassName("features")(0).innerText
                results(r, 3) = item.getElementsByClassName("promo_offers")(0).innerText
                results(r, 4) = item.getElementsByClassName("board_rate")(0).innerText
                results(r, 5) = item.getElementsByClassName("price")(0).innerText
                On Error GoTo 0
            Next
        Next
        ws.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        ws.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
        .Quit
    End With
End Sub

2

QHarr 22 फरवरी 2019, 15:08

क्लासनाम द्वारा डेटा स्क्रैपिंग तत्व

1 उत्तर

संबंधित सवाल

नए सवाल