Download innertext from html pages

Hi

this code download innertext of instagram urls

urls  >>> sheet 1 : a1 to lastrow 

but why err  in Third url

im Amateur  pls help me.

pic 🙁http://s9.picofile.com/file/8336922700/6789.png)

 

 

Sub test()

    Dim wb As Object
    Dim doc As Object
    Dim sURL As String
    Dim lastrow As Long
    Dim n As Integer
    Dim i As Integer
    Dim HtmlToText As String
    Dim result
    lastrow = Sheet1.Cells(Rows.Count, “A”).End(xlUp).Row
    For i = 2 To lastrow
       
        Set wb = CreateObject(“internetExplorer.Application”)
        sURL = Cells(i, 1)
        wb.navigate sURL
        wb.Visible = False
        While wb.Busy
          DoEvents
        Wend
        ‘HTML document
        Set doc = wb.document
        Dim Name As Variant
        Dim Posts As Variant
        Dim Following As Variant
        Dim Followers As Variant
        Dim DivValue As Variant
        Dim DivValueSplit As Variant
        Dim DivValueResult As Variant
        Dim Biography As Variant
       
       Name = doc.getElementsByClassName(“AC5d8 notranslate”)(0).innerText
        Posts = doc.getElementsByClassName(“g47SY”)(0).innerText
        Followers = doc.getElementsByClassName(“g47SY”)(1).innerText
        Following = doc.getElementsByClassName(“g47SY”)(2).innerText
       
        ‘dd = web.document.querySelector(“div.-vDIg span”).innerText
       
       DivValue = doc.getElementsByClassName(“-vDIg”)(0).innerHTML
        DivValueSplit = Split(DivValue, “<br>”)
        DivValueResult = DivValueSplit(1)
        j = InStr(DivValueResult, “</span>”)
        Biography = Mid(DivValueResult, 7, j – 7)
      Worksheets(“sheet1”).Cells(i, 2) = Name
        Worksheets(“sheet1”).Cells(i, 3) = Followers
        Worksheets(“sheet1”).Cells(i, 4) = Following
        Worksheets(“sheet1”).Cells(i, 5) = Posts
        Worksheets(“sheet1”).Cells(i, 6) = Biography
       
        Biography = Replace(re1, “<span>”, “”)
               
        Cells(i, 2) = HtmlToText
         myarray = Split(Data, vbCrLf)
err_clear:
        If Err <> 0 Then
          Err.Clear
          Resume Next
        End If
        wb.Quit
           
    Next i

End Sub

 

By: kaprio

Leave a Reply

Your email address will not be published. Required fields are marked *