URL-адрес изменяется динамически, и необходимо извлекать данные в один лист Excel с использованием VBA. - PullRequest
0 голосов
/ 10 февраля 2020

URL-адрес изменяется динамически. Например:

  1. https://www.ziprecruiter.com/candidate/search?days=5&search=nav&location=USA&page=2

  2. https://www.ziprecruiter.com/candidate/search?days=5&search=nav&location=USA&page=3

в том же листе Excel

 Sub GetJobTitles()
 Const Url$ = "https://www.ziprecruiter.com/candidate/search?days=5&search=nav&location=USA"
 Dim post As Object, R&

 With CreateObject("InternetExplorer.Application")
 .Visible = True
 .navigate Url
 While .Busy Or .readyState < 4: DoEvents: Wend
 For Each post In .document.getElementsByTagName("article")
 R = R + 1: Cells(R, 1) = post.getElementsByClassName("just_job_title")(0).innerText
 Cells(R, 2) = post.getElementsByClassName("name")(0).innerText
 Cells(R, 3) = post.getElementsByClassName("location")(0).innerText

 Next post
 .Quit
 End With
 End Sub

1 Ответ

2 голосов
/ 10 февраля 2020

Следующее должно работать. Дайте ему шанс:

Sub GetJobInfo()
    Const URL$ = "https://www.ziprecruiter.com/candidate/search?days=5&search=nav&location=USA&page="
    Dim IE As Object: Set IE = CreateObject("InternetExplorer.Application")
    Dim post As Object, elem$, R&, I&: I = 1

    Do
        With IE
            .Visible = True
            .navigate URL & I
            While .Busy Or .readyState < 4: DoEvents: Wend

            On Error Resume Next
            elem = .document.getElementsByTagName("article")(0).innerText
            On Error GoTo 0

            If elem = "" Then Exit Do

            For Each post In .document.getElementsByTagName("article")
                R = R + 1: Cells(R, 1) = post.getElementsByClassName("just_job_title")(0).innerText
                Cells(R, 2) = post.getElementsByClassName("name")(0).innerText
                Cells(R, 3) = post.getElementsByClassName("location")(0).innerText
            Next post
        End With
        I = I + 1
        elem = ""
        Application.Wait Now + TimeValue("00:00:05")
    Loop
    IE.Quit
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...