Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос для сбора названий сайтов по ключевому слову, макрос по поиску сайтов по конкретной тематике
 
#1
05.03.2020 15:38:06
Просьба подсказать новичку существует ли техническая возможность по созданию макроса, который бы через Яндекс собирал адреса сайтов в таблицу. Конкретнее: пользователь нажимает кнопку макроса - вводит ключевое слово (запрос для Яндекса), макрос самостоятельно открывает браузер, вводит запрос в поиск и затем собирает все сайты, которые нашел Яндекс в таблицу excel. Поиск можно ограничить 10 страницами выдачи. Было бы замечательно увидеть любую часть кода такого макроса, например код для открытия браузера и размещения запроса в яндексе. Ничего похожего на данном ресурсе не нашел, если что-то пропустил - поделитесь ссылкой, пожалуйста.
 
 
 
#2
05.03.2020 15:59:34
Что-то вроде:
Код
Sub GetYandexAnswer()
    Dim res, response$
    Dim oXMLHTTP As Object
    Dim sp_start&, lp&, le&, lpages&
    Dim sReqWord$
'    On Error Resume Next
    sReqWord = "суп"
    Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    
    For lpages = 0 To 9
        With oXMLHTTP
            .Open "GET", "https://yandex.ru/search/?text=" & sReqWord & "&p=" & lpages, False
            .send
            Do While .readyState <> 4
              DoEvents
            Loop
            response = .responseText
        End With
        lp = 1
        le = 0
        If Len(response) Then
            Do
                lp = InStr(lp, response, "<a class=""link link_theme_normal organic__url link_cropped_no", 1)
                If lp > 0 Then
                    lp = InStr(lp, response, "href=" & Chr(34), 1)
                    If lp > 0 Then
                        le = InStr(lp + 6, response, Chr(34), 1)
                        res = Mid(response, lp + 6, le - lp - 6)
                        Debug.Print res
                    End If
                End If
                DoEvents
            Loop While lp > 0
        End If
    Next
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#3
06.03.2020 13:18:14
Дмитрий(The_Prist) Щербаков, СПАСИБИЩЕ!!!! Интересный макрос!
 
 
 
#4
06.03.2020 14:05:32
Дмитрий(The_Prist) Щербаков, макрос работал прекрасно, но в какой-то момент макрос перестал работать, с моими доработками это не связано. Алгоритм проверил до Метки 3. Я не понимаю как работают поисковые серверы, подозреваю, что Яндекс мог меня заблокировать. Может быть проверите в чем дело? Вот алгоритм с небольшими доработками
Код
Sub GetYandexAnswer()
    Dim res, response$
    Dim oXMLHTTP As Object
    Dim sp_start&, lp&, le&, lpages&
    Dim sReqWord$
'    On Error Resume Next
    sReqWord = "инструмент Самара"
    Sheets("Яндекс").Cells.Clear
    schet = 5
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
     
    For lpages = 0 To 9
        With oXMLHTTP
           .Open "GET", "https://yandex.ru/search/?text=" & sReqWord & "&p=" & lpages, False
            .send
            Do While .readyState <> 4
              DoEvents
            Loop
            response = .responseText
        End With
        lp = 1
        le = 0
   '     MsgBox "Метка"
        If Len(response) Then
            Do
            '     MsgBox "Метка 2" '''''''работает
                 lp = InStr(lp, response, "<a class=""link link_theme_normal organic__url link_cropped_no", 1)
                If lp > 0 Then
                        MsgBox "Метка 3" '''''''''не работает
                    lp = InStr(lp, response, "href=" & Chr(34), 1)
                    If lp > 0 Then
                        le = InStr(lp + 6, response, Chr(34), 1)
                        res = Mid(response, lp + 6, le - lp - 6)
                        Debug.Print res

                        
                        MsgBox "le =" & le
                        MsgBox "res =" & res
                        With Sheets("Яндекс")
                            .Cells(schet, 2).Value = res
                        End With
                        schet = schet + 1
                        
                        

                    End If
                End If
                DoEvents
            Loop While lp > 0
        End If
    Next
With Sheets("Яндекс")
    Range("A3:B4").Font.Bold = True
    Range("A4:B4").Borders.LineStyle = True
    .Cells(3, 2).Value = "Данные по запросу:  " + sReqWord
    .Cells(4, 1).Value = "№ п/п"
    .Cells(4, 2).Value = "Ссылка на сайт"
End With
    MsgBox "Готово!"
End Sub
 
 
 
#5
06.03.2020 14:09:21
А что у меня должно произойти? У меня записывает все страницы.
И да, Яндекс может заблокировать, заметив очень подозрительные обращения(слишком частые).
Можете поиграться с разными задержками между запросами(минута или около того).
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#6
06.03.2020 14:23:41
Дмитрий(The_Prist) Щербаков, подскажите еще, пожалуйста, что это означает?
Код
.readyState <> 4
Это интервал ожидания Яндекса? Его нужно увеличить?
 
 
 
#7
06.03.2020 14:27:07
о-о-о...как все запущено :) Нет, это строка ждет пока страница загрузится. 4 - это статус страницы, означающий, что она загружена. Вот мы и крутим там цикл до тех пор, пока не загрузится полностью. Иначе можно просто получить код неполной страницы или не получить его вовсе.

А чтобы сделать то, что я написал выше(задержку) - код надо переписывать, добавляя перед каждым запросом некую задержку, чтобы у яндекса хоть как-то создалось впечатление, будто мы это сделали не автоматом. И то не факт, что это поможет 100%. Яндекс он тоже не дурак :)
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#8
06.03.2020 14:32:45
Дмитрий(The_Prist) Щербаков, почитал инет, похоже на защиту Яндекса или особенности internet explorera. Буду изучать вопрос дальше. Подскажите, а для Хрома можно сделать такой макрос. что нужно в коде поменять?
 
 
 
#9
06.03.2020 15:13:50
Этот макрос вообще не привязан ни к какому браузеру...
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#10
07.03.2020 12:42:20
Дмитрий(The_Prist) Щербаков, может нужно добавить заголовки, чтобы поисковик не блокировал запросы макроса?
Рецепт взят с видео Alemoxa.
Код
Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
XMLHTTP.Open "GET", URL, False
'ЗАГОЛОВКИ пишутся после комманды OPEN
XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/70.0.3538.102 Safari/537.36 OPR/57.0.3098.116"
XMLHTTP.setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,image/apng,*/*;q=0.8"
XMLHTTP.setRequestHeader "Accept-Encoding", "gzip, deflate"
XMLHTTP.setRequestHeader "Content-Type", "text/html; charset=WINDOWS-1251"
On Error GoTo Exit1
XMLHTTP.SEND
 
 
 
#11
07.03.2020 13:03:04
Цитата
Niko.x87 написал:
может нужно добавить заголовки
может. А может и не поможет. Я просто привел пример кода получения данных с первых 10 страниц - ковыряться во всех причинах блокировок должен тот, кому это больше нужно :) Т.к. у каждого сайта свои загоны на этот счет.  
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#12
08.03.2020 23:00:33
Цитата
может нужно добавить заголовки
они, конечно, желательны, но проблему не решат

Необходимо:
1) авторизация на сайте (яндекс хочет знать, что это человек)
2) использовать специальные прокси-серверы, которые еще не засветились в яндексе
иначе рано или поздно всё равно выскочит капча (нужно ввести текст с картинки)

Короче, парсинг Яндекса - весьма непростая задача
(я настраивал парсинг тысяч сайтов, а вот за настройку под парсинг поисковой выдачи яндекса до сих пор не берусь, слишком уж там надо заморачиваться, если требуется чтобы это долго и стабильно работало)

PS: поищите спец. программы для парсинга выдачи поисковых систем (там уже всё продумано)
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#13
11.03.2020 13:54:26
Дмитрий(The_Prist) Щербаков, если вас не обременит, можете показать вариант этого же макроса, чтобы он не генерировал запросы на яндекс, а брал информацию из открытого сеанса браузера (то есть, чтобы пользователь предварительно руками вводил запрос)?
 
 
 
#14
11.03.2020 16:47:46
Цитата
VIZ_VIZ написал:
показать вариант этого же макроса, чтобы он не генерировал запросы на яндекс, а брал информацию из открытого сеанса браузера
нет, т.к. это уже совсем другая песня. Не все браузеры в принципе готовы позволить к себе подключиться извне. Не говоря уже о том, чтобы определить в каком чего открыто сейчас пользователем.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
Страницы: 1
Читают тему
Наверх