Запрос yellowpages.com вернуть адреса улиц
Я пытаюсь взять список имен и почтовых индексов из Excel, последовательно вводить их по одному имени и почтовому индексу в поля поиска на сайте www.yellowpages.com и возвращать результаты адресов улиц в Excel в той же последовательности, что и оригинал. имена и почтовые индексы. Сообщение об ошибке не возвращается, оно просто останавливается без завершения. Я не уверен, где он останавливается, но он открывает Internet Explorer, вводит условия поиска и нажимает кнопку поиска, потому что я вижу это, когда.visible = True. Мое лучшее предположение между "".
Вот мой код (адаптированный от DontFretBrett и Dinesh Kumar Takyar):
Sub Address_Scrape()
Dim eRow As Long
Dim ele As Object
Dim wb As Workbook
Dim srch As Worksheet
Dim trgt As Worksheet
Set wb = ThisWorkbook
Set srch = wb.Sheets("Master with addresses")
Set trgt = wb.Sheets("Sheet1")
Dim url As String
Dim zc As String
Dim Name As String
Name = srch.Range("B2")
zc = srch.Range("F2")
url = "URL;http://www.yellowpages.com/"
url = url & "/" & zc & "/" & Name
RowCount = 1
trgt.Range("A" & RowCount) = "Name"
trgt.Range("B" & RowCount) = "Address"
trgt.Range("C" & RowCount) = "City"
trgt.Range("D" & RowCount) = "State"
trgt.Range("E" & RowCount) = "Zip"
eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
.navigate "http://www.yellowpages.com/"
.Visible = True
Do While .Busy Or _
.readyState <> 4
DoEvents
Loop
Set who = .document.getElementsByName("search_terms")
who.Item(0).Value = Name
Set where = .document.getElementsByName("geo_location_terms")
where.Item(0).Value = zc
.document.forms(0).submit
Do While .Busy Or _
.readyState <> 4
DoEvents
Loop
"Results = .document.getElementsByTagName("p")(0).innerText"
For Each ele In .document.all
Select Case ele.tagName
Case Results
RowCount = RowCount + 1
Case "Name"
trgt.Range("A" & RowCount) = ele.getElementByclass("business-name").innerText
Case "Address"
trgt.Range("B" & RowCount) = ele.getElementByclass("street-address").innerText
Case "City"
trgt.Range("C" & RowCount) = Trim(ele.getElementByclass("locality").innerText)
Case "State"
trgt.Range("D" & RowCount) = ele.getElementByitemprop("addressRegion").innerText
Case "Zip"
trgt.Range("E" & RowCount) = ele.getElementByitemprop("postalCode").innerText
End Select
Next ele
Set objIE = Nothing
End With
End Sub
1 ответ
Вы хотите в основном очистить данные от поиска желтых страниц.
Некоторое время назад я сделал полезную надстройку для Excel, чтобы делать такие поиски, не прибегая к VBA: http://blog.tkacprow.pl/excel-scrape-html-add/
Давайте начнем с самого начала, структура GET URL:
http://www.yellowpages.com/search?search_terms=[SEARCH_TERM]&geo_location_terms=[LOCATION]
Где [SEARCH_TERM] и [LOCATION] - ваши параметры GET.
Теперь, скажем, используя функции из надстройки, вы хотите получить текст элемента с именем класса "business-name", используйте эту функцию:
=GetElementByRegex("http://www.yellowpages.com/search?search_terms=[SEARCH_TERM]&geo_location_terms=[LOCATION]"; "class=""business-name""[^<>]*?>((?:.|\n)*?)<[^<>]*?/")
Нет VBA, просто регулярные выражения. Просто замените параметры GET своими собственными. Конечно, в случае разных элементов регулярное выражение может отличаться - но это все же проще, чем писать VBA с нуля.
Надеется, что это помогает.