时间戳

首页 > 解决方案 > 从网站查询选择器中提取链接全部

excel - 从网站查询选择器中提取链接全部

问题描述

我已使用以下 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#/?类别=全部

进入excel电子表格。但这里似乎有一些问题，我的电子表格中没有显示任何内容。感谢是否有人可以在这里指出我的错误。

以下是我希望将其提取到 Excel 电子表格中的网站链接列表。 在此处输入图像描述

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

标签： excelvbaweb-scraping

解决方案

尝试

For i = 0 To links.Length -1

和

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

假设选择器正确。nodeLists 基于 0。

推荐阅读