Điều khiển Chrome, Chromium Edge, Cốc Cốc, FireFox … bằng VBA

Chia sẻ bởi:hands

★★★★★

‹ Trình tải xuống liên kết ảnh, nhạc,... Tra cứu Kê Khai Hải Quan nhanh... ›

Quảng cáo

Hôm nay tôi sẽ hướng dẫn các bạn cách điều khiển một trình duyệt hoạt động dựa vào nhân Chromium.

Cài đặt:
1. SeleniumBasic
github.com/florentbr/SeleniumBasic/releases/tag/v2.0.9.0

2. Tải Chromedriver.exe sao chép vào thư mục: SeleniumBasic đã cài đặt
sites.google.com/a/chromium.org/chromedriver/downloads
Thường thì đường dẫn là C:UsersxxxxxxxxxxxAppDataLocalSeleniumBasic

Để cập nhật Chromedriver.exe tự động có thể sử dụng Code sau:

Đặt đường dẫn Chrome trước khi cập nhật:
Thường thì C:Program Files (x86)GoogleChromeApplicationchrome.exe

#If VBA7 Then
     Public Declare PtrSafe 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
#Else
     Public 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

Sub btn_UpdateChromedriver()
  Debug.Print UpdateChromedriver
End Sub
Function UpdateChromedriver(Optional ByVal chromePath As String = "C:Program Files (x86)GoogleChromeApplicationchrome.exe") As Boolean
  On Error Resume Next
  Dim LastedUpdate As String
  Dim FSO As Object, SEPath$
  Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
  Dim XMLHTTP As Object
  Dim a, Tmp1$, Tmp$, eURL$, Temp$, Info$
  Const LATEST_RELEASE = "chromedriver.storage.googleapis.com/LATEST_RELEASE"
  Const URL$ = "chromedriver.storage.googleapis.com/"

Const EXE$ = "chromedriver.exe"
  Const ZIP$ = "chromedriver_win32.zip"
  SEPath$ = Environ$("USERPROFILE") & "AppDataLocalSeleniumBasic"
  Temp = Environ("TEMP"): GoSub DelTemp
  If Not FSO.FileExists(chromePath) Then Exit Function
  Info = FSO.GetFileVersion(chromePath)
  eURL = "chromedriver.storage.googleapis.com/LATEST_RELEASE_" & Split(Info, ".")(0)
  GoSub http
  LastedUpdate = VBA.GetSetting("Chromedriver", "Update", "Last")
  If LastedUpdate < Tmp Then
    GoSub Download
  End If
Ends: Set FSO = Nothing
Exit Function
Download:
On Error Resume Next
  eURL = URL$ & Tmp & "/chromedriver_win32.zip"
  If URLDownloadToFile(0, eURL, Temp & ZIP, 0, 0) = 0 Then
    GoSub Extract
    Call VBA.SaveSetting("Chromedriver", "Update", "Last", Tmp)
  End If
On Error GoTo 0
Return
Extract:
On Error Resume Next
With VBA.CreateObject("Shell.Application")
  .Namespace(Temp & "").CopyHere .Namespace(Temp & ZIP).Items
End With
With FSO
  If .FileExists(Temp & EXE) Then
    If .FolderExists(SEPath) Then FSO.CopyFile Temp & EXE, SEPath & EXE, True
  End If
  UpdateChromedriver = Err.Number = 0
End With
On Error GoTo 0
GoSub DelTemp
Return

DelTemp:
On Error Resume Next
  FSO.DeleteFile Temp & ZIP
  FSO.DeleteFile Temp & EXE
On Error GoTo 0
Return
http:
Set XMLHTTP = VBA.CreateObject("MSXML2.XMLHTTP.6.0")
With XMLHTTP
  .Open "GET", eURL, False
  .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/83.0.4103.97 Safari/537.36"
  .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
  .Send
  Tmp = VBA.Trim(Application.Clean(.responseText))
End With
Return
End Function

————————————————-

Bước tiếp theo là Mở kết nối đến chrome:

Dưới đây là một thủ tục kiểm tra và mở kết nối và kết nối phiên cũ của Chrome
Thủ tục Chrome_SE có nhiều tham số:

Optional ByRef Driver As selenium.WebDriver: Lớp đối tượng chính Webdriver để kết nối
Optional ByRef boolStart As Boolean: Đối số trả ngược xem Chrome đã khởi động chưa
Optional ByVal URL As String: website để load
Optional ByVal IndexPage As Integer: Kết nối thứ tự website trùng nhau
Optional ByRef boolWait As Boolean: Đợi chrome load xong
Optional ByRef refBoolCheckUrl As Boolean: Kiểm tra website đã có chưa
Optional ByVal boolStartIfExists As Boolean: Nếu có vẫn load thêm
Optional ByVal boolNewTab As Boolean: Mở trong tab mới
Optional ByVal lngPort As Long = 9222: Port kết nối của Chromedriver thường thì 9222, 9333, 9444, 9555, 9666, 9777, …
Optional ByVal boolApp As Boolean: Khởi động khung Chrome ở chế độ Application
Optional ByVal lngVisible = vbNormalFocus: Khung hiển thị của Chrome, lặn, toàn màn hình, bình thường
Optional ByVal boolMaximize As Boolean: Toàn màn hình
Optional ByVal strPosition As String = "0,0": Vị trí bắt đầu của khung Chrome
Optional ByVal strSize As String = "1900,1053": Độ rộng của khung chrome
Optional ByVal boolGPU As Boolean = True: cho phép phần cứng GPU
Optional ByVal boolClose As Boolean
Optional ByVal strBrowser As String = "chrome": phân trình duyệt chrome hay các trình duyệt khác
Optional ByVal strChromePath As String = Chrome_ROOT: Đường dẫn đã cài đặt chrome
Optional ByVal strUserDataDir As String: Dữ liệu tạm được lưu ở đâu, mặc định là trong thư mục Temp

Hãy chạy thủ tục Chrome_SE_test để kiểm thử.

Sửa hằng Chrome_ROOT là đường dẫn Chrome được cài trên máy hiện hành.
————————————————-

Option Explicit
Const Chrome_ROOT$ = "C:Program Files (x86)GoogleChromeApplicationchrome.exe"
Public oChromeDriver As Object
Private Sub Chrome_SE_test()
  Call Chrome_SE(oChromeDriver, URL:="www.giaiphapexcel.com/diendan/whats-new/", _
                  boolStart:=True, refBoolCheckUrl:=True, lngVisible:=1, _
                  boolMaximize:=True, strPosition:="0,0", strSize:="1800,1053")
End Sub

Function Chrome_SE( _
              Optional ByRef Driver As selenium.WebDriver, _
              Optional ByRef boolStart As Boolean, _
              Optional ByVal URL As String, _
              Optional ByVal IndexPage As Integer = 1, _
              Optional ByRef boolWait As Boolean, _
              Optional ByRef refBoolCheckUrl As Boolean, _
              Optional ByVal boolStartIfExists As Boolean, _
              Optional ByVal boolNewTab As Boolean, _
              Optional ByVal lngPort As Long = 9222, _
              Optional ByVal boolApp As Boolean, _
              Optional ByVal lngVisible = vbNormalFocus, _
              Optional ByVal boolMaximize As Boolean, _
              Optional ByVal strPosition As String = "0,0", _
              Optional ByVal strSize As String = "1900,1053", _
              Optional ByVal boolGPU As Boolean = True, _
              Optional ByVal boolClose As Boolean, _
              Optional ByVal strBrowser As String = "chrome", _
              Optional ByVal strChromePath As String = Chrome_ROOT, _
              Optional ByVal strUserDataDir As String) As Boolean

Dim Win, Process, isBrowserOpen As Boolean, isOpen As Boolean, K%, i%
  If lngPort <= 0 Then lngPort = 9222
  If strUserDataDir = vbNullString Then
    strUserDataDir = IIf(Environ$("tmp") <> vbNullString, Environ$("tmp"), Environ$("temp")) & "remote-profile-cr"
  End If
  GoSub CheckCR: isOpen = isBrowserOpen
  If Not isOpen Then
    If Not boolStart And Not boolStartIfExists Then GoTo Ends
    Dim CmdLn$
    CmdLn = _
      IIf(lngPort > 0, " --remote-debugging-port=" & lngPort, "") & _
      IIf(strUserDataDir <> vbNullString, " --user-data-dir=""" & strUserDataDir & """", "") & _
      " --lang=en" & _
      IIf(URL = "", "", IIf(boolApp, " --app=", " ")) & URL & _
      IIf(boolMaximize And lngVisible <> 0, " --start-maximized", "") & _
      IIf(strPosition <> vbNullString And Not boolMaximize, " --window-position=" & strPosition, "") & _
      IIf(strSize <> vbNullString And Not boolMaximize, " --window-size=" & strSize, "") & _
      IIf(boolGPU, "", " --disable-gpu")
    Shell strChromePath & "" & CmdLn, vbNormalFocus
    Do Until isBrowserOpen:
      GoSub CheckCR: For i = 1 To 1000: Next
      K = K + 1: If K > 12 Then GoTo Ends
    Loop
  End If
  If Driver Is Nothing Then
    Set Driver = New selenium.ChromeDriver
    Driver.SetCapability "debuggerAddress", "127.0.0.1:" & lngPort
    Driver.Start "chrome"
    'Driver.setImplicitWait 5000
    'Driver.setTimeout 120000
    Driver.Timeouts.PageLoad = 10000
    Driver.Timeouts.Server = 10000
    GoSub FindChrDrv
  End If
  GoSub CheckUrl
Ends:
Chrome_SE = isBrowserOpen
Set Process = Nothing: Set Win = Nothing
Exit Function
CheckUrl:
  If Not refBoolCheckUrl Then Return
  K = 0
  On Error Resume Next
  refBoolCheckUrl = False
  For Each Win In Driver.Windows
    If Err.Number <> 0 Then Return
    Win.Activate
    LCase$ (Driver.URL) Like "*" & LCase$(URL) & "*"
    If LCase$(Driver.URL) Like "*" & LCase$(URL) & "*" Then
      K = K + 1: If IndexPage = K Then refBoolCheckUrl = True: Exit For
    End If
  Next
  If Not refBoolCheckUrl Or (boolStartIfExists And refBoolCheckUrl) Then
    If boolNewTab Then
      Driver.ExecuteScript "window.open(arguments[0], '_blank');", URL
    Else
      Driver.Get URL
    End If
  End If
  On Error GoTo 0
Return
FindChrDrv:
  For Each Process In GetObject("winmgmts:\.rootCIMV2") _
    .execquery("SELECT * FROM Win32_Process WHERE Name = ""chromedriver.exe""", , 48)
    Set oChromeDriver = Process: Exit For
  Next
Return
CheckCR:
  For Each Process In GetObject("winmgmts:\.rootCIMV2") _
    .execquery("SELECT * FROM Win32_Process WHERE Name = """ & strBrowser & ".exe""", , 48)
    If LCase$(Process.commandLine) Like _
       LCase$("*" & strBrowser & "*--remote-debugging-port=" & _
        lngPort & "*--user-data-dir=*" & LCase$(strUserDataDir) & "*") Then
      isBrowserOpen = True: If boolClose Then Process.Terminate: Set Driver = Nothing: GoTo Ends
      Exit For
    End If
  Next
Return
End Function

Sub Close_SE(ByRef Driver As selenium.WebDriver)
  Dim Win
  On Error Resume Next
  For Each Win In Driver.Windows: Win.Close: Next: Driver.Quit
  Set Win = Nothing: Set Driver = Nothing
  On Error GoTo 0
End Sub

————————————————-
Các bạn có thể điều khiển Chrome dựa vào Lớp Driver hoặc JavaScript trong lệnh Execute của lớp Driver

(Còn tiếp)