seleniumbasic+VBA配置自动控制网页
基本配置
下载安装seleniumbasic
1.首先,下载Selenium Basic安装程序。您可以从以下链接下载最新版本的Selenium Basic:https://florentbr.github.io/SeleniumBasic/。
2.运行Selenium Basic安装程序,并按照安装向导的指示进行操作。在安装过程中,您可以选择要安装的浏览器驱动程序,例如ChromeDriver、FirefoxDriver等。(就是一路Accept、next)
3.安装完成后,启动Excel,并在VBA编辑器中选择“工具”菜单,然后选择“引用”。
4.在“可用引用”列表中,找到“Selenium Type Library”并选中该库,然后单击“确定”按钮。这将向您的VBA项目中添加对Selenium Basic的引用。
5.现在,您可以在VBA项目中编写使用Selenium Basic的代码,并运行它。
下载webdriver
保证浏览器driver 和你的浏览器版本相配: ChromeDriver - WebDriver for Chrome - Downloads
以Chrome 浏览器为例,不同的版本对应不同的驱动器:ChromeDriver - WebDriver for Chrome - Downloads (chromium.org)
将匹配的driver 复制到 SeleniumBasic 的安装文件夹 ,例如: C:\Users\[你的用户名]\AppData\Local\SeleniumBasic
如果驱动器的版本不对的话,就无法启动浏览器.
下载 MS .Net 3.5 : Download Microsoft .NET Framework 3.5 from Official Microsoft Download Center
这一步很重要. 没有.Net, 运行VBA的时候会出现Automation Error的报错.
在VBAReferences 中选择Selenium Type Library. 然后就可以在VBA里使用Selenium 了.
例:启动Chrome浏览器登陆网页并下载指定起始日期数据再复制到指定工作表
Public Driver As New ChromeDriver '这句必须放在过程外部,否则过程结束了,浏览器就会自动关闭
Public lastSheet, downloadPath, lastSheetName As String
Public shtUser, shtMoban1, shtPaiBan As Worksheet '用车人对帐单、对帐单模板1、对帐单模板2、排班调度明细
Sub 同步数据()
'安装 Selenium 2.0.9
'配置当前版本的Chrome Driver
'参照Tools->Reference->Selenium Type Library
'Selenium使用教程:https://club.excelhome.net/thread-1452021-3-1.html
' https://www.cnblogs.com/ryueifu-VBA/?page=5
'
' Dim Driver As New ChromeDriver
Application.DisplayAlerts = False '屏弊提示,避免删除工作表时弹出提示
'要操作的表格
Set shtUser = Sheets("用车人对帐单")
Set shtMoban1 = Sheets("对帐单模板1")
Set shtPaiBan = Sheets("排班调度明细")
shtUser.Activate '激活
Dim url As String
Dim MyLogin As String
Dim MyPassword As String
Dim startDate As String
Dim waitListings, waitSearch, waitDownload As Long
Dim waitOpen As Single
Dim c As Range
'设置网站登录页面的URL
url = "https://tms.***.cn/#/login"
'设置登录信息
MyLogin = "***"
MyPassword = "***"
'获取查询起始日期
Set c = shtUser.Range("A1:Z100").Find(What:="起始日期")
startDate = shtUser.Cells(c.Row, c.Column).Offset(0, 2) '
'获取浏览器下载目录
Set c = shtUser.Range("A1:Z100").Find(What:="下载目录")
If shtUser.Cells(c.Row, c.Column + 2) = "" Then '未指定目录
downloadPath = Environ$("USERPROFILE") & "\Downloads\"
Else '指定目录
downloadPath = shtUser.Cells(c.Row, c.Column + 2)
End If
' Debug.Print downloadPath, lastSheet
'获取目录等待时间
Set c = shtUser.Range("A1:Z100").Find(What:="目录等待")
waitListings = shtUser.Cells(c.Row, c.Column).Offset(0, 2)
'获取查询等待时间
Set c = shtUser.Range("A1:Z100").Find(What:="查询等待")
waitSearch = shtUser.Cells(c.Row, c.Column).Offset(0, 2)
'获取下载等待时间
Set c = shtUser.Range("A1:Z100").Find(What:="下载等待")
waitDownload = shtUser.Cells(c.Row, c.Column).Offset(0, 2)
'获取打开等待时间
Set c = shtUser.Range("A1:Z100").Find(What:="打开等待")
waitOpen = shtUser.Cells(c.Row, c.Column).Offset(0, 2)
'Debug.Print waitListings
'打开Chrome浏览器
Driver.Start "Chrome"
'访问登录页面
Driver.Get url
'输入用户名和密码
Driver.FindElementByXPath("//*[@ng-model='user.userName']").SendKeys (MyLogin) '填写用户名
Driver.FindElementByXPath("//*[@ng-model='user.password']").SendKeys (MyPassword) '填密码
'//从任意节点开始,不是从根节点
'tbody是标签节点
'[]是谓语的用法,谓语用来查找某个特定的节点或者包含某个指定的值的节点
'谓语中的@id节点的属性 ,即网页中的标签的id @id='separatorline' 表示,id必须是 forumnewshow
'following::轴,表示与本元素相邻的兄弟元素
'提交登录表单
Driver.FindElementByXPath("//*[@type='submit']").Click '登陆
Driver.Wait 1000
'》排班管理
Driver.FindElementByXPath("//span[contains(text(),'排班管理')]").Click '
Driver.Wait waitListings ' 等待列表加载
Driver.FindElementByXPath("//span[contains(text(),'排班调度')]").Click '排班调度
Driver.Wait 2500
'超始日期
Driver.FindElementByXPath("//*[@placeholder='起始日期']").Clear
Driver.FindElementByXPath("//*[@placeholder='起始日期']").SendKeys (startDate) '
' driver.FindElementByXPath("//button[contains(text(),'今天')]").Click '截止日期“默认今天”
Driver.Wait 5000
Driver.FindElementByXPath("//button[contains(text(),'查询')]").Click '查询
Driver.Wait waitSearch ' 等待查询结果
' Driver.FindElementByXPath("//*[@ng-click='exportAll(-1)']").WaitEnabled , 5000 '等待导出按钮可用
Driver.FindElementByXPath("//*[@ng-click='exportAll(-1)']").Click '导出(Chrome浏览器自动开始下载)
Driver.Wait waitDownload '下载等待
Call getLastSheet(downloadPath) '获取下载表格的全名
' ActiveWorkbook.Close '关闭下载表
'激活“排班报表明细”,删除原数据
shtPaiBan.Activate
Cells.Select '全选
Cells.Delete '删除
'打开下载的表格,并全选复制
mOpen = Shell("Explorer.exe " & downloadPath & lastSheet, vbNormalFocus)
Call delay(waitOpen) '打开等待3秒
Call getAEndRow(ActiveSheet.Name) '获取当前表格最后一行行号
Set c = ActiveSheet.UsedRange.Find("终点站")
'将“终点站”减号改为逗号
ActiveSheet.Range(Cells(1, c.Column), Cells(aEndRow, c.Column)).Replace What:="-", Replacement:=",", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, MatchByte:=False, SearchFormat:=True, ReplaceFormat:=True
Cells.Select '全选
ActiveSheet.Cells.Copy '复制
Application.EnableEvents = False
' lastSheetName = ActiveWorkbook.Name
'
ActiveWorkbook.Close SaveChanges:=True
'“排班报表明细”,粘贴
shtPaiBan.Range("A1").PasteSpecial '粘贴
shtUser.Activate '激活“用户对帐单“
' '检查是否成功登录
If shtPaiBan.Range("A1") <> "" Then
Set c = Sheets("用车人对帐单").Range("A1:Z100").Find("数据版本")
Worksheets("用车人对帐单").Cells(c.Row, c.Column + 2) = Now() '数据版本为当前时间
Set c = Sheets("自动报表生成").Range("A1:Z100").Find("数据版本")
Sheets("自动报表生成").Cells(c.Row, c.Column + 1) = Now
MsgBox "已更新至:" & FileDateTime(downloadPath & lastSheet)
Else
MsgBox "更新失败!"
End If
' Stop
'关闭浏览器
Driver.Quit
Exit Sub
1:
MsgBox "测试"
End Sub
Sub getLastSheet(SourceFolderName) '获取最新下载的表格全称 SourceFolderName As String
Dim FSO As Object
Dim SourceFolder As Object
Dim FileItem As Object
Dim cCount As Boolean '比较次数
cCount = False
Dim maxDate As Date '最新表格修改时间
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
'获取修改时间最新的文件全名(含后缀)
For Each FileItem In SourceFolder.Files
ccdate = Format((FileItem.DateLastModified), "yyyy-mm-dd hh:mm:ss") '获取当前文件对象修改日期时间
If cCount = False Then '第1次直接引用
lastSheet = FileItem.Name
maxDate = Format((FileItem.DateLastModified), "yyyy-mm-dd hh:mm:ss")
cCount = True
ElseIf maxDate < ccdate Then '第2次引用日期时间最大的
maxDate = ccdate
lastSheet = FileItem.Name
End If
' Debug.Print maxDate, ccdate
Next FileItem
'Debug.Print lastSheet
End Sub
Chrome浏览器禁止更新(我是没有成功过,还是自动更新)
Chrome浏览器默认会自动更新版本,这样造成已有的Selenium项目必须重新下载相应的驱动文件,才能正确运行。
下面介绍一种禁止浏览器更新的方法。
Chrome浏览器通常安装在如下两个位置:
"C:\Program Files\Google\Chrome\Application\chrome.exe"
或者
"C:\Users\用户名\AppData\Local\Google\Chrome\Application\chrome.exe"
对应的更新文件GoogleUpdate.exe可能位于如下场所:
"C:\Program Files (x86)\Google\Update\GoogleUpdate.exe"
或者
"C:\Users\用户名\AppData\Local\Google\Update\GoogleUpdate.exe"
找到这个更新文件后,重命名即可。例如修改为GoogleUpdateexe
VBA SelenuimV3版本AddArgument 参数
Dim Options As SeleniumBasic.ChromeOptions
With Options
.AddExcludedArgument "enable-automation"
.AddArgument "--start-maximized"
End With
AddArgument常用的还有:
AddArgument "--user-agent=" 设置请求头的User-Agent
AddArgument "--window-size=1280x1024" # 设置浏览器分辨率(窗口大小)
AddArgument "--start-maximized" # 最大化运行(全屏窗口),不设置,取元素会报错 AddArgument "--disable-infobars" # 禁用浏览器正在被自动化程序控制的提示
AddArgument "--incognito" # 隐身模式(无痕模式)
AddArgument "--hide-scrollbars" # 隐藏滚动条, 应对一些特殊页面
AddArgument "--disable-javascript" # 禁用javascript
AddArgument "--blink-settings=imagesEnabled=false" # 不加载图片, 提升速度
AddArgument "--headless" # 浏览器不提供可视化页面
AddArgument "--ignore-certificate-errors" # 禁用扩展插件并实现窗口最大化
AddArgument "--disable-gpu" # 禁用GPU加速
AddArgument "–disable-software-rasterizer"
AddArgument "--disable-extensions"
AddArgument "--start-maximized"
更多推荐
所有评论(0)