Код VBA, который открывает ссылки и ищет динамические ключевые слова в ссылках - PullRequest
Новая
       4

Код VBA, который открывает ссылки и ищет динамические ключевые слова в ссылках

0 голосов
/ 04 февраля 2019

Я провел много исследований по этому вопросу, но я не могу понять, как именно решить мою проблему.В столбце N: N у меня есть сотни ссылок, которые я хочу просмотреть и открыть.Как только код открывает их, у меня есть другой рабочий лист с динамическим списком слов / фраз, которые я хочу, чтобы код ссылался при поиске по каждой отдельной ссылке.Если код не находит ничего на странице, он закрывает окно и переходит к следующей ссылке.Если он находит совпадения (не нужно учитывать регистр), то он копирует все слова / фразы в соответствующие ячейки O: O, каждая из которых разделена знаком «;».

Основываясь на моих исследованиях,У меня есть фрагмент кода, который откроет ссылки: 

Dim ie As Object   
Set ie = CreateObject("InternetExplorer.Application") 
ie.Visible = True   
Dim x As Integer 
Dim links As Hyperlinks 
Set links = ActiveSheet.Hyperlinks  
For x = 1 To links.Count 
    ie.navigate links.Item(x).Address, Nothing, "_blank"
Next

Однако я не могу найти ничего, что могло бы помочь мне с последней частью этого кода.Я довольно хорошо знаком с VBA, но это выходит за рамки моих навыков.

Спасибо заранее!

1 Ответ

0 голосов
/ 05 февраля 2019

Для поиска по ключевым словам или тексту на веб-странице, вы можете сослаться на пример кода ниже. 

Sub scraper()

        Dim site As String
        Dim lastRow As Long
        Dim ie

        With ActiveSheet
            lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        End With

            Set ie = CreateObject("internetexplorer.application")
            ie.Visible = True

            ie.navigate site

            'idle while ie is busy
            Do
            Loop Until ie.readystate = 3
            Do
            Loop Until ie.readystate = 4

            With ie.document
                .getelementbyid("UserName").Value = uName
                .getelementbyid("Password").Value = uPass
                .forms(0).submit
            End With
            On Error GoTo error

            Do
            Loop Until ie.readystate = 3
            Do
            Loop Until ie.readystate = 4

            For i = 2 To lastRow

                site = Range("A" & i).Value
                ie.navigate site

            Do
            Loop Until ie.readystate = 3
            Do
            Loop Until ie.readystate = 4


        msg = ie.document.Body.innerhtml
        If InStr(msg, "Text To Find") = 0 Then
            ActiveSheet.Range("B" & i).Value = "Not Found"
        Else
            ActiveSheet.Range("B" & i).Value = "Found"
       End If
jump:
            Next i
        Exit Sub
error:
    ActiveSheet.Range("B" & i).Value = "Unknown Error!"
Resume jump


End Sub

Это пример кода, вы можете попробовать изменить его в соответствии с вашими собственными требованиями.

Ссылка:

Поиск веб-страницы для определенного текста

Для копирования, вставки значений из одной ячейки в другую, Вы можетеСсылка ниже может дать вам представление.

Лучший способ копировать и вставлять специальные значения только с VBA

...