使用VBA+Selenium可以很便利地在浏览器上进行操作, 以及抓取一些需要的信息.
先分享一个例子, 抓取VBA贴吧的首页所有标题, 以及相应的每个链接, 效果图如下.
代码如下:
Option Explicit
'安装 Selenium 2.0.9
'配置当前版本的Chrome Driver
'参照Tools->Reference->Selenium Type Library
Public cd As Selenium.ChromeDriver
Sub TiebaList_Selenium()
Dim titles As Selenium.WebElements
Dim title As Selenium.WebElement
Dim url As String, row As Long
url = "https://tieba.baidu.com/f?kw=vba&ie=utf-8"
Set cd = New Selenium.ChromeDriver
With cd
.AddArgument "start-maximized" '窗口最大化
.Start
.Get url '访问网址
.FindElementById("head").WaitDisplayed '等待head显示
Set titles = .FindElementsByXPath("//*[@id='thread_list']//div/div[2]/div[1]/div[1]/a") '抓取首页
row = 1
For Each title In titles
''Debug.Print title.Text
Range("A" & row + 1) = title.Text
Range("B" & row + 1).Hyperlinks.Add Range("B" & row + 1), title.Attribute("href")
row = row + 1
Next title
.Quit '退出
End With
End Sub

顶！
这个是网页浏览贴吧，没登陆状态下的？

代码注释中的第一行应为：'安装SeleniumBasic 2.0.9

今天再来分享一个使用VBA+Selenium在购物网站上面抓取VBA相关的图书价格.
主要功能: 输入关键字, 选择图书分类, 点击搜索按钮, 在表内写入第一页的60个搜索结果
代码分享:
'安装 SeleniumBasic 2.0.9
'配置当前版本的Chrome Driver
'参照Tools->Reference->Selenium Type Library
Public cd As Selenium.ChromeDriver
Sub Dangdang_Selenium()
Dim searchResults As Selenium.WebElements, rs As Selenium.WebElement
Dim prices As Selenium.WebElements, price As Selenium.WebElement
Dim url As String, row As Long
url = "http://www.dangdang.com/"
Set cd = New Selenium.ChromeDriver
With cd
.AddArgument "start-maximized" '窗口最大化
.Start
.Get url '访问网址
.FindElementById("key_S").SendKeys "VBA"
.FindElementByXPath("//*[@id='form_search_new']/span").Click '选择分类
.FindElementByXPath("//*[@id='search_all_category']/a[3]").Click
.FindElementByXPath("//*[@id='form_search_new']/input[10]").Click '点击搜索
Set searchResults = .FindElementsByName("itemlist-title")
Set prices = .FindElementsByXPath("//*/p[3]/span[1]")
'输出书名
row = 1
For Each rs In searchResults
Range("A" & row + 1) = rs.Text
row = row + 1
Next rs
'输出价格
row = 1
For Each price In prices
If Len(Range("A" & row + 1)) > 0 Then
Range("B" & row + 1) = price.Text
row = row + 1
Else
Exit For
End If
Next price
.Quit '退出
End With
End Sub

欢迎吧友提供抓包需求素材

今日分享, 使用VBA+Selenium在豆瓣抓取指定话题的最新图片.
主要功能: API函数URLDownloadToFile下载文件, 获取图片集合, 获取图片链接
代码分享:
Option Explicit
'安装 SeleniumBasic 2.0.9
'配置当前版本的Chrome Driver
'Tools->Reference->Selenium Type Library->OK
'声明API函数
#If VBA7 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( _
ByVal pCaller As LongPtr, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As LongPtr, _
ByVal lpfnCB As LongPtr) As LongPtr
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( _
ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
#End If
Public cd As Selenium.ChromeDriver
Sub Douban_Selenium()
Dim url As String, row As Long
Dim strFileName As String, strPath As String, FullName As String
Dim clsIMG As Selenium.WebElements, img As Selenium.WebElement, link As String
url = "https://www.douban.com/gallery/topic/108090/?sort=new" '话题->镜头下的秋天
strPath = Environ$("USERPROFILE") & "\Downloads\" '下载路径
Set cd = New Selenium.ChromeDriver
With cd
.AddArgument "start-maximized" '窗口最大化
.Timeouts.PageLoad = 20000 '加载时长20秒
.Start
.Get url, Raise:=False '访问网址(忽略错误提示)
Set clsIMG = .FindElementsByClass("img-wrapper") '获取图片集合
For Each img In clsIMG
link = img.FindElementByTag("img").Attribute("src") '获取图片链接(默认为small size)
' link = Replace(link, "/s/", "/l/") '替换为large size链接
strFileName = Mid(link, InStrRev(link, "/") + 1) '截取文件名
FullName = strPath & strFileName '合成完整路径
URLDownloadToFile 0, link, FullName, 0, 0 '下载文件
Next img
.Quit '退出
End With
End Sub

楼主威武，一统江湖

今日分享, 使用VBA+Selenium在TED抓取视频的标题,作者,日期,以及超链接.
主要功能: 多页数循环, 获取视频集合, 跳过无标题的视频
代码分享:
Option Explicit
'安装 SeleniumBasic 2.0.9
'配置当前版本的Chrome Driver
'Tools->Reference->Selenium Type Library->OK
Public cd As Selenium.ChromeDriver
Sub TED_Selenium()
Dim url As String, row As Long
Dim cntPage As Integer, page As Integer
Dim clsMedia As Selenium.WebElements, media As Selenium.WebElement
Dim title As String, author As String, postedDate As String, link As String
url = "https://www.ted.com/talks?language=zh-cn&page="
Set cd = New Selenium.ChromeDriver
With cd
.AddArgument "start-maximized" '窗口最大化
.Timeouts.PageLoad = 10000 '加载时长10秒
.Start baseUrl:="https://www.ted.com"
.Get "/", Raise:=False '访问网址(忽略错误提示)
cntPage = 5 '指定页数
' cntPage = .FindElementByXPath("//*[@id='browse-results']/div[2]/div/a[5]").TextAsNumber '最大页数
row = 2
For page = 1 To cntPage
.Get url & page, Raise:=False '访问网址(忽略错误提示)
Set clsMedia = .FindElementsByClass("media__message") '获取视频集合
For Each media In clsMedia
If UBound(Split(media.Text, Chr(10))) > 1 Then '跳过无标题的视频
author = Split(media.Text, Chr(10))(0)
title = Split(media.Text, Chr(10))(1)
postedDate = Split(media.Text, Chr(10))(2)
postedDate = Mid(postedDate, InStr(postedDate, " ") + 1)
link = media.FindElementByTag("a").Attribute("href") '获取视频链接
'写入Excel
Cells(row, "A") = title
Cells(row, "B") = author
Cells(row, "C") = postedDate
Cells(row, "D").Hyperlinks.Add Cells(row, "D"), link
row = row + 1
End If
Next media
Next
.Quit '退出
End With
End Sub

顶

pc端回帖提示APP扫一扫是什么操作？求助：有没有好用的移动端VB Editor？

看看是啥

能抓取试题答案吗

安装SeleniumBasic，使用VBA自动完成浏览器中的操作

这代码复制了可以直接用吗