Извлечь ссылку из селектора запросов веб-сайта все - PullRequest
Новая
       4

Извлечь ссылку из селектора запросов веб-сайта все

0 голосов
/ 07 мая 2020

Я использовал приведенный ниже код vba для извлечения ссылки на веб-сайт из

https://www.bursamalaysia.com/market_information/announcements/company_announcement?keyword=&cat=FA%2CFRCO&sub_type=&company=&mkt=&alph=&sec=&subsec=&dt_ht=23%2F04%2F2020&dt_lt=07%2F05%2F2020# /? Category = all

в таблицу Excel. Но, похоже, здесь какие-то проблемы, в моей таблице ничего не отображается. Благодарю, если кто-нибудь может указать на мою ошибку здесь.

Ниже приведен список ссылок на веб-сайты, по которым я sh извлекаю их в электронную таблицу Excel. enter image description here

Sub ScrapLink()

Dim p As Integer

Application.ScreenUpdating = False

p = InputBox("Please insert page number")

Application.ScreenUpdating = False
On Error GoTo ErrorHandler:

Worksheets("results").Cells(1, 1).Value = Worksheets("sheet1").Cells(1, 1).Value

For u = 2 To p
Worksheets("results").Cells(u, 1).Value = Worksheets("sheet1").Cells(1, 1).Value & "&page=" & u
Application.DisplayAlerts = False

Application.DisplayAlerts = True

ErrorHandler:
Application.ScreenUpdating = True

Next u


Dim IE As New InternetExplorer, html As HTMLDocument
Dim x As Long

Application.ScreenUpdating = False

x = WorksheetFunction.CountA(Worksheets("results").Range("A1:A1000"))

With IE
For u = 1 To x

IE.Visible = True
IE.Navigate Worksheets("results").Cells(u, 1).Value

While .Busy Or .ReadyState < 4: DoEvents: Wend
Application.Wait Now + TimeSerial(0, 0, 1)
Application.StatusBar = "Trying to go to website"
DoEvents


Dim links As Object, i As Long
    Set links = .Document.querySelectorAll("#bm_ajax_container 
    [href^='/market_information/announcements/company_announcement/']")
    For i = 1 To links.Length
        With ThisWorkbook.Worksheets("Sheet1")
             Range("A" & rows.count).End(xlUp).Offset(1).Value = links.item(i - 1)
        End With
    Next i
Next u
.Quit
End With


Worksheets("results").Range("a1:a1000").Clear

End Sub

1 Ответ

1 голос
/ 07 мая 2020

Попробуйте 

For i = 0 To links.Length -1

и 

Range("A" & rows.count).End(xlUp).Offset(1).Value = links.item(i ).href

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

...