- 帖子
- 354
- 主題
- 5
- 精華
- 0
- 積分
- 387
- 點名
- 0
- 作業系統
- windows7
- 軟體版本
- vba,vb,excel2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2017-1-8
- 最後登錄
- 2024-8-2
 
|
50#
發表於 2023-8-20 19:38
| 只看該作者
本帖最後由 singo1232001 於 2023-8-20 19:47 編輯
回復 49# Scott090
本人不是很專業 自己也沒把握可以100%沒問題
加上不知道之後有那些網址與語法是固定的
所以可以先將就用看看
Sub updataSelenium()
'由於selenium有可能會安裝在windows下兩個其中一個資料夾中 所以要先找出資料夾位置 (mac目前未考慮)
path1 = "C:\Users\" & Environ$("username") & "\AppData\Local\SeleniumBasic\Chromedriver.exe"
path2 = "C:\Program Files\SeleniumBasic\chromedriver.exe"
If Dir(path1) <> "" Then TempDrvFile = path1
If Dir(path2) <> "" Then TempDrvFile = path2
foler = Left(TempDrvFile, InStrRev(TempDrvFile, "\")) '取得 資料夾路徑 與 chromedrive.exe 路徑
'獲取當前chromedriver版本前兩碼 例: 117.0
Set oShell = CreateObject("wscript.shell")
errcode = oShell.Exec(TempDrvFile & " --version").StdOut.ReadAll
verarr = Split(errcode, " ")
chrdrv = verarr(1)
dotsarr2 = Split(chrdrv, ".")
'獲取chrome當前瀏覽器版本號 例: 117.0
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0") 'Get chrome version
chrversion = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Software\Google\Chrome\BLBeacon\version")
dotsarr = Split(chrversion, ".")
leftchrver = dotsarr(0) & dotsarr(1)
'比對chromedriver 與 chrome瀏覽器 兩個版本號, 相同(不更新) ; 不同(上官網查瀏覽器最新版本號 並繼續下載解壓取代)
leftchrdrv = dotsarr2(0) & dotsarr2(1)
If leftchrver = leftchrdrv Then Exit Sub
'到官網api獲取版本資訊 並拆解資訊 該資訊為json格式 並獲得當前瀏覽器可用的chromedriver版本號
'本json拆法為特製 不符合正規json 不知道未來的格式會不會變 因為不想引用額外物件
Url = "https://googlechromelabs.github.io/chrome-for-testing/latest-versions-per-milestone.json"
Call objHTTP.Open("GET", Url, False)
Call objHTTP.Send("")
version_number = objHTTP.responseText
v0 = Split(version_number, ",""milestones"":{")
v1 = Split(v0(1), "},")
For i = 0 To UBound(v1)
v1(i) = Replace(v1(i), """", "")
v1(i) = Replace(v1(i), ":{milestone:", ",")
v1(i) = Replace(v1(i), ",version:", ",")
v1(i) = Replace(v1(i), ",revision:", ",")
v1(i) = Replace(v1(i), "}}}", ",")
Next
ReDim v2(UBound(v1))
For i = 0 To UBound(v1): v2(i) = Split(v1(i), ","): Next
For i = 0 To UBound(v2)
If v2(i)(0) = dotsarr(0) Then: version_number = v2(i)(2): Exit For
Next
'生成連結網址 (另須注意選擇作業系統位元 在下方cmd處 也有需要修改的部分) 不知道未來網址會不會變
'download_url = "https://edgedl.me.gvt1.com/edgedl/chrome/chrome-for-testing/" & version_number & "/linux64/chromedriver-linux64.zip"
'download_url = "https://edgedl.me.gvt1.com/edgedl/chrome/chrome-for-testing/" & version_number & "/mac-x64/chromedriver-mac-x64.zip"
'download_url = "https://edgedl.me.gvt1.com/edgedl/chrome/chrome-for-testing/" & version_number & "/win32/chromedriver-win32.zip"
download_url = "https://edgedl.me.gvt1.com/edgedl/chrome/chrome-for-testing/" & version_number & "/win64/chromedriver-win64.zip"
Call objHTTP.Open("GET", download_url, False)
Call objHTTP.Send("")
Set fileStream = CreateObject("ADODB.Stream") '使用adodb.stream 接受檔案
With fileStream
.Open
.Type = 1 'adTypeBinary
.Write objHTTP.responseBody
.Position = 0
.SaveToFile foler & "chromedriver.zip", 2 ' 下載檔案到selenium資料夾 ' 2 adSaveCreateOverWrite
.Close
End With
'使用shell+cmd殺舊的檔案 kill的方式被微軟封了
Set oApp = CreateObject("Shell.Application")
cmdCommand = "cmd /c del " & foler & "chromedriver.exe" '使用cmd刪除檔案 cmd /c del "path"
Call Shell(cmdCommand, vbHide) '殺掉舊的chromedriver.exe
cmdCommand = "cmd /c del " & foler & "LICENSE.chromedriver"
Call Shell(cmdCommand, vbHide) '殺掉舊的LICENSE.chromedriver
'若沒殺成功 該程序沒關閉 無法刪除時 將執行佇列中的檔案關閉 'cmd /c taskkill /F /IM chromedriver.exe 是殺佇列
If Dir(foler & "chromedriver.exe") <> "" Then
cmdCommand = "cmd /c taskkill /F /IM chromedriver.exe && cmd /c del " & foler & "chromedriver.exe" '殺掉舊的chromedriver.exe
Call Shell(cmdCommand, vbHide)
End If
If Dir(foler & "LICENSE.chromedriver") <> "" Then
cmdCommand = "cmd /c taskkill /F /IM LICENSE.chromedriver && cmd /c del " & foler & "LICENSE.chromedriver" '殺掉舊的LICENSE.chromedriver
Call Shell(cmdCommand, vbHide)
End If
'將新的chromedriver.exe解壓縮到資料夾中 16是強制取代選項 注意壓縮檔內的檔名 會因系統位元不同資料夾不同
oApp.Namespace(foler).CopyHere _
oApp.Namespace(foler & "chromedriver.zip\chromedriver-win64").items, 16
End Sub |
|
