Запрос 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 с нуля.

Надеется, что это помогает.

Другие вопросы по тегам