Home » excel » excel – Scrape data from list of websites

excel – Scrape data from list of websites

Posted by: admin May 14, 2020 Leave a comment

Questions:

`I’m trying to scrape data such as

Date of Incorporation, Email Address,Address and Director Details
From a list of 500 websites which is in https://www.zaubacorp.com/company-list/nic-300-company.html which extends to many pages. I need to extract websites, which i have done using Power query in excel, but then to extract specific details from each website is a tedious work in Power Query.

Also,the issue lies in the Email Address and Address, unable to find a class/tag ID name.(This i have got recently , but now i need help with the huge chunk of websites, the code should work for all websites(since they have same type of data at specific places.

Sub GetInfo()
    Const URL = "https://www.zaubacorp.com/company/TECHDRIVE-SOFTWARE-LIMITED/U30007DL1999PLC356280"
    Dim Html As New HTMLDocument
    Dim elem As Object, adr As Object

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .send
        Html.body.innerHTML = .responseText
    End With

    For Each elem In Html.getElementsByTagName("b")
        If InStr(elem.innerText, "Email ID:") > 0 Then
            [A2] = elem.ParentNode.innerText
            Exit For
        End If
    Next elem

    For Each adr In Html.getElementsByTagName("b")
        If InStr(adr.innerText, "Address:") > 0 Then
            [B2] = adr.ParentNode.NextSibling.innerText
            Exit For
        End If
    Next adr
End Sub
How to&Answers:

I’ve modified your existing script to traverse multiple pages which is now able to extract name,Date of Incorporation,email and address of each container from there. Make sure to create a sheet named DataContainer before executing the script below.

Sub GetInfo()
    Const prefix$ = "https://www.zaubacorp.com/company-list/nic-300/p-"
    Const suffix$ = "-company.html"
    Dim Html As New HTMLDocument, Htmldoc As New HTMLDocument
    Dim newHtml As New HTMLDocument, newUrl$, elem As Object, oDate As Object, R&, I&
    Dim Wb As Workbook, ws As Worksheet, adr As Object, P&, pageNum&

    Set Wb = ThisWorkbook
    Set ws = Wb.Worksheets("DataContainer") '----------->create a sheet and name it `DataContainer` in order for the script to write the results in there

    For pageNum = 1 To 2  '---------------------------------> this is where you put the highest number the script will traverse
        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", prefix & pageNum & suffix, False
            .send
            Html.body.innerHTML = .responseText
        End With

        With Html.querySelectorAll("#table tbody tr")
            For I = 0 To .Length - 1
                Htmldoc.body.innerHTML = .item(I).outerHTML
                newUrl = Htmldoc.querySelector("a[href]").getAttribute("href")

                With CreateObject("MSXML2.XMLHTTP")
                    .Open "GET", newUrl, False
                    .send
                    newHtml.body.innerHTML = .responseText
                End With

                R = R + 1: ws.Cells(R, 1) = newHtml.querySelector(".container > h1").innerText

                For Each oDate In newHtml.getElementsByTagName("p")
                    If InStr(oDate.innerText, "Date of Incorporation") > 0 Then
                        ws.Cells(R, 2) = oDate.ParentNode.NextSibling.innerText
                        Exit For
                    End If
                Next oDate

                For Each elem In newHtml.getElementsByTagName("b")
                    If InStr(elem.innerText, "Email ID:") > 0 Then
                        ws.Cells(R, 3) = elem.ParentNode.innerText
                        Exit For
                    End If
                Next elem

                For Each adr In newHtml.getElementsByTagName("b")
                    If InStr(adr.innerText, "Address:") > 0 Then
                        ws.Cells(R, 4) = adr.ParentNode.NextSibling.innerText
                        Exit For
                    End If
                Next adr
            Next I
        End With
    Next pageNum
End Sub