CODEWITHSUNDEEP
vbaexcelwebweb-scraping
user2964645
user2964645

Reputation: 13

Fetch Data from a web page to Excel using VBA

I am trying to pull data from the following web page.

https://pro.calnea.com/login

User: [email protected]

Pass: calnea1

Once logged in hoover over "Pro Services" and click "Comps Search (Photo)". I have typed a post code in and ticked a couple of properties already which should put them in the Shortlist. To access the short list go to the bottom on the page and on the right, there is a button which says "View Shortlist", click that. Now you see the selected properties and I want to pull each piece of data for each property, for example, cell A1 = Address, A2 = Last Sales Price, A3 = Last Sales Date etc all the way to Status. Then the next property on the next line so B1 = Address etc. If possible I want to get the image URL as well.

I am not sure of the best way around this as there is a log in however I am remaining logged in on the browser so I assume this isnt an issue?

Below is what I have so far but unfortunately I am having no luck and help would be MUCH appreciated! :)

Sub test()
Dim eRow As Long
Dim ele As Object
Set sht = Sheets("Sheet1")
RowCount = 1
sht.Range("A" & RowCount) = "Address"
sht.Range("B" & RowCount) = "Last Sales Price"
sht.Range("C" & RowCount) = "Last Sales Date"
sht.Range("D" & RowCount) = "Property Type"

eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

Set objIE = CreateObject("InternetExplorer.Application")


With objIE
.Visible = True
.navigate "http://pro.calnea.com/client/cmp_shortlist/bs6?Require_EA=false&SearchMode=CMP"
Do While .Busy Or _
.readyState <> 4
DoEvents
Loop
Set what = .document.getElementsByName("q")
what.Item(0).Value = Address
Set Address = .document.getElementsByName("where")
Address.Item(0).Value = Last Sales Price
.document.getElementById("View Shortlist").Click
Do While .Busy Or _
.readyState <> 4
DoEvents
Loop
For Each ele In .document.all
Select Case ele.classname
Case "Result"
RowCount = RowCount + 1
Case "Title"
sht.Range("A" & RowCount) = ele.innertext
Case "Company"
sht.Range("B" & RowCount) = ele.innertext
Case "Location"
sht.Range("C" & RowCount) = ele.innertext
Case "Description"
sht.Range("D" & RowCount) = ele.innertext
End Select
Next ele
End With
Macro1
Set objIE = Nothing
End Sub

Upvotes: 0

Views: 23752

Answers (1)

jacouh
jacouh

Reputation: 8741

I seen the link from Fetch data from zoopla.co.uk, I just corrected some VBA syntax error, please check this:

Sub sofFetchDataFromWebPage()
  Dim RowCount, eRow As Long
  Dim sht, ele As Object, what, Address
  Dim objIE

'
  Set sht = Sheets("Sheet1")
'
' Set sht = ActiveSheet

  RowCount = 1
  sht.Range("A" & RowCount) = "Address"
  sht.Range("B" & RowCount) = "Last Sales Price"
  sht.Range("C" & RowCount) = "Last Sales Date"
  sht.Range("D" & RowCount) = "Property Type"

  eRow = sht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

  Set objIE = CreateObject("InternetExplorer.Application")

  With objIE
    .Visible = True
    .Navigate "http://pro.calnea.com/client/cmp_shortlist/bs6?Require_EA=false&SearchMode=CMP"
    Do While .Busy Or .readyState <> 4
      DoEvents
    Loop
    Set what = .document.getElementsByName("q")
    what.Item(0).Value = "Address"
    Set Address = .document.getElementsByName("where")
    Address.Item(0).Value = "Last Sales Price"
    .document.getElementById("View Shortlist").Click
    Do While .Busy Or .readyState <> 4
      DoEvents
    Loop
    For Each ele In .document.all
      Select Case ele.classname
        Case "Result"
          RowCount = RowCount + 1
        Case "Title"
         sht.Range("A" & RowCount) = ele.innertext
        Case "Company"
          sht.Range("B" & RowCount) = ele.innertext
        Case "Location"
          sht.Range("C" & RowCount) = ele.innertext
        Case "Description"
          sht.Range("D" & RowCount) = ele.innertext
      End Select
    Next
  End With
  Set objIE = Nothing
End Sub

As you has logged in in another IE Window, you may not need do login here again.

Upvotes: 1

Related Questions