2013-11-14 108 views
0

我正在嘗試從以下網頁中提取數據。使用VBA將數據從網頁提取到Excel

https://pro.calnea.com/login

用戶:[email protected]

通行證:calnea1

一旦登錄胡佛在 「專業服務」,然後點擊 「搜索譜曲(照片)」。我已經輸入了一個郵政編碼並勾選了一些屬性,這些屬性應該將它們放入候選名單中。要訪問短名單,請點擊頁面底部右側的按鈕,顯示「查看候選名單」,點擊。現在您可以看到選定的屬性,並且我想要爲每個屬性提取每個數據,例如單元格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 
+2

非常不好的做法發佈您的信息登錄本網站,我已經刪除它爲您的利益。 – Sorceri

+0

@Sorceri事實上,你提到你刪除它,現在有人可以看到編輯[歷史](http://stackoverflow.com/posts/19984280/revisions)不是我會用別人的密碼,但只是說它不完全除去。 –

+0

盡我所能去除它,這是我所能做的,幫助他們。沒有人應該將他們的信息發佈到公共場所。如果你不會發布這個鏈接,它可能仍然是一種隱藏,但現在任何人都可以看看你的鏈接! – Sorceri

回答

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窗口登錄,您可能不需要做再次登錄。

+0

感謝您查看代碼。我已經點亮了我需要爲每個屬性採集的信息,並粘貼到Excel的每一行上,但是代碼無法正常工作。我只要求它獲得四條數據,直到我找到它才能保持簡單,但最終的結果是獲取每一行上每個屬性的所有信息。任何幫助,這將是偉大的。謝謝[鏈接](http://s13.postimg.org/58f585ihj/CAlnea.png) – user2964645

+0

任何想法? – user2964645

+1

您應該研究返回的HTML文檔結構以查看類名,標記名,屬性以確定獲取數據的策略。 – jacouh

相關問題