使用 VBA 从网页中获取数据到 Excel
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/19984280/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Fetch Data from a web page to Excel using VBA
提问by user2964645
I am trying to pull data from the following web page.
我正在尝试从以下网页中提取数据。
User: [email protected]
Pass: calnea1
通过：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.
登录后，通过“Pro Services”并单击“Comps Search（Photo）”。我已经输入了一个邮政编码并已经勾选了几个属性，这些属性应该将它们放入Shortlist。要访问短名单，请转到页面底部和右侧，有一个显示“查看短名单”的按钮，单击该按钮。现在您看到了选定的属性，我想为每个属性提取每条数据，例如，单元格 A1 = 地址、A2 = 最后销售价格、A3 = 最后销售日期等一直到状态。然后是下一行的下一个属性，所以 B1 = 地址等。如果可能的话，我也想获取图像 URL。
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
回答by jacouh
I seen the link from Fetch data from zoopla.co.uk, I just corrected some VBA syntax error, please check this:
我看到了来自 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
As you has logged in in another IE Window, you may not need do login here again.
由于您已在另一个 IE 窗口中登录，因此您可能不需要再次在此处登录。
