【发布时间】:2020-08-22 06:02:49
【问题描述】:
我使用下面的 vba 代码从
中提取网站链接到 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
【问题讨论】:
-
你的意思是“刮”? “遇到一些问题”并不能真正描述您所面临的问题。您能否编辑您的问题并描述您在哪一行遇到问题?
标签: excel vba web-scraping