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"