使用VBA將網頁中的數據提取到Excel

Question

我正在嘗試從以下網頁中提取數據。

https://pro.calnea.com/login

用戶：tyronr@outlook.com

通行證：calnea1

將鼠標懸停在“ Pro Services”上，然后單擊“ Comps Search（照片）”。 我已經輸入了一個郵政編碼，並在幾個屬性上打了勾，這些屬性應該將它們放到候選清單中。 要訪問簡短列表，請轉到頁面底部的右側，然后是一個顯示“查看簡短列表”的按鈕，然后單擊該按鈕。 現在，您看到了選定的屬性，我想將每個屬性的每條數據提取出來，例如，單元格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

Answer 1

我看過來自zoopla.co.uk的Fetch data鏈接，我剛剛更正了一些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窗口中登錄，因此您可能不需要在此處再次登錄。