如何使用VBA在excel文档中循环浏览超链接
如何使用VBA在excel文档中循环浏览超链接
提问于 2019-06-04 22:08:58
我有一份情况清单。一列中包含160个excel中的超链接。我正在尝试从这些单独的链接中提取数据。以便导航到特定页面(例如https://www.oddschecker.com/golf/canadian-open/winner/bet-history/dustin-johnson)。
注意：出于测试目的，代码的范围很小。
我认为最好的过程是：
对于链接2，单击并打开每个单独的超链接并拉取information
- Close
- Repeat
- Repeat for link 3
我在编写代码时遇到了麻烦，这些代码将单击并随后从一个链接循环到下一个链接，例如从单元格A6到单元格A7。
我尝试过使用涉及.click操作的For each循环。
不幸的是，我还没有在上述方面取得任何成功。
如果能提供一些帮助，或者如果有人能给我指出进一步调查的方向，我将不胜感激。
Public Sub GetReleaseTimes()
Dim ie As Object, hTable As HTMLTable, clipboard As Object, ws2 As Worksheet, ws1 As Worksheet, URL As Range
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ie = CreateObject("InternetExplorer.Application")
Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
With ie
.Visible = True
.navigate2
For Each URL In ws1.Range("A6:A10").Click
While .Busy Or .readyState < 4: DoEvents: Wend
Set hTable = .document.querySelector(".eventTable")
clipboard.SetText hTable.outerHTML
clipboard.PutInClipboard
ws2.Range("A1").PasteSpecial
Next
.Quit
End With
End Sub回答 1
Stack Overflow用户
回答已采纳
发布于 2019-06-05 03:17:08
请不要单击超链接打开浏览器进行抓取。将链接读入一个数组，循环该数组，并对每个url执行.navigate2。
此外，当你从剪贴板粘贴时，你需要找到最后使用的行，而不管列是什么，然后在每一次旋转下面粘贴一到两行。
Option Explicit
Public Sub GetReleaseTimes()
Dim ie As Object, hTable As HTMLTable, clipboard As Object
Dim ws2 As Worksheet, ws1 As Worksheet, urls()
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ie = CreateObject("InternetExplorer.Application")
Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
urls = Application.Transpose(ws1.Range("A6:A10").Value)
With ie
.Visible = True
For i = LBound(urls) To UBound(urls)
.Navigate2 urls(i)
While .Busy Or .readyState < 4: DoEvents: Wend
Set hTable = .document.querySelector(".eventTable")
clipboard.SetText hTable.outerHTML
clipboard.PutInClipboard
ws2.Range("A" & GetLastRow(ws2) + 2).PasteSpecial
Next
.Quit
End With
End Sub
Public Function GetLastRow(ByVal sh As Worksheet) As Long
On Error Resume Next
GetLastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/56445651
复制相关文章
相似问题