使用VBA将数据从网页提取到Excel

时间:2013-11-14 17:25:01

标签: excel vba excel-vba web web-scraping

我正在尝试从以下网页提取数据。

https://pro.calnea.com/login

用户:tyronr@outlook.com

通过:calnea1

在“Pro Services”上登录胡扯,然后点击“Comps Search(Photo)”。我输入了一个邮政编码,并勾选了几个属性,这些属性应该将它们列入候选名单。要访问短名单,请转到页面底部和右侧,有一个显示“查看候选名单”的按钮,单击该按钮。现在您看到所选属性,我想为每个属性提取每个数据,例如,单元格A1 =地址,A2 =上次销售价格,A3 =上次销售日期等一直到状态。然后下一行的下一个属性,所以B1 =地址等。如果可能,我也想获得图像URL。

我不确定最好的办法,因为有登录但是我仍然登录浏览器,所以我认为这不是问题吗?

以下是我到目前为止的情况,但不幸的是我没有运气,我将非常感谢你的帮助! :)

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

1 个答案:

答案 0 :(得分:1)

我看到Fetch data from zoopla.co.uk的链接,我刚刚更正了一些VBA语法错误,请检查一下:

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

当您在另一个IE窗口中登录时,您可能不需要再次登录。