• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Want to have some scraped information into a CSV output using VBA

shahin

Active Member
Hi there! I've made a parser using vba which is scraping information successfully from a site and getting stratified into an excel file. I would like to have that output in a CSV file. I never worked with this CSV stuff. So, if anybody stretches a helping hand to solve this issue, I would be very happy. I'm pasting here the code I've come so far with. Thanks in advance.

Code:
Sub YPdata()

Dim http As New MSXML2.XMLHTTP60, html As New HTMLDocument
Dim ag As Object, bg As Object, cg As Object
Dim x As Long, lrow As Long, i As Long, Z As Long

x = 2
Set ag = html.getElementsByClassName("business-name")
Set bg = html.getElementsByClassName("adr")
Set cg = html.getElementsByClassName("phones phone primary")

http.Open "GET", "http://www.yellowpages.com/search?search_terms=Coffee%20Shops&geo_location_terms=San%20Francisco%2C%20CA&page=3", False
http.send
html.body.innerHTML = http.responseText

If ag.Length > 0 Or bg.Length > 0 Or cg.Length > 0 Then
For i = 0 To ag.Length - 1
    Cells(x, 1) = ag(i).innerText
    Cells(x, 2) = bg(i).innerText
    Cells(x, 3) = cg(i).innerText
    x = x + 1
Next i
End If

End Sub
 
Something like below.

Code:
Sub YPdata()

Dim http As New MSXML2.XMLHTTP60, html As New HTMLDocument
Dim ag As Object, bg As Object, cg As Object
Dim x As Long, lrow As Long, i As Long, Z As Long

x = 2
Set ag = html.getElementsByClassName("business-name")
Set bg = html.getElementsByClassName("adr")
Set cg = html.getElementsByClassName("phones phone primary")

http.Open "GET", "http://www.yellowpages.com/search?search_terms=Coffee%20Shops&geo_location_terms=San%20Francisco%2C%20CA&page=3", False
http.send
html.body.innerHTML = http.responseText

If ag.Length > 0 Or bg.Length > 0 Or cg.Length > 0 Then
For i = 0 To ag.Length - 1
    Cells(x, 1) = ag(i).innerText
    Cells(x, 2) = bg(i).innerText
    Cells(x, 3) = cg(i).innerText
    x = x + 1
Next i
End If
Range("A1:C1") = Array("Business Name", "Address", "Phone Number")

Dim fPath As String: fPath = ThisWorkbook.Path & "/YourFileName.csv"
Dim wb As Workbook
Set wb = Workbooks.Add
ThisWorkbook.Sheets(1).UsedRange.Copy wb.Sheets(1).Cells(1)

wb.SaveAs Filename:=fPath, FileFormat:=xlCSV, CreateBackup:=False
wb.Close False

End Sub
 
I was not home. Arrived just now, opened the PC and, bam, it is working smoothly. You made my day. Thanks sir for everything.
 
Btw, if i knew earlier that some specific excel gurus available in this forum are willing to solve almost every problem without thinking their own selves, i would not have wasted my time in stackoverflow. Thanks again sir.
 
Back
Top