Scott090

回復 50# singo1232001


    感謝大大用心地協助。
    Google Chrome 常常在改版本實 在是捆擾，它的 雲端硬碟 ChromeDriveFs 也是。

singo1232001

回復 51# Scott090

由於有人不知道要去安裝主插件 所以也把插件安裝流程寫進去了
https://github.com/florentbr/SeleniumBasic/releases
SeleniumBasic v2.0.9.0.exe
第一次安裝完成後,必須在開始>執行selenium中的start chrome
等待錯誤彈出並確定,將自動安裝.net framwork 安裝完畢後重開機
再執行本程序則可以更新版本


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 路徑
'若未安裝selenium 2.0.9.0 將會跳轉到github網站 請自行下載安裝
If foler = "" Then
    msg = "(請拍照抓圖本畫面)" & vbCrLf
    msg = msg & "找不到selenium插件資料夾 需至網站" & vbCrLf & "https://github.com/florentbr/SeleniumBasic/releases"
    msg = msg & vbCrLf & "下載安裝 SeleniumBasic v2.0.9.0.exe" & vbCrLf & vbCrLf & "是否直接前往?"
    msg = msg & vbCrLf & vbCrLf & "注意後續步驟:" & vbCrLf & "第一次安裝完成後,必須在開始>執行selenium中的start chrome" & vbCrLf
    msg = msg & "等待錯誤彈出並確定,將自動安裝.net framwork 安裝完畢後重開機" & vbCrLf & "再執行本程序則可以更新版本"
    x = MsgBox(msg, vbYesNo, "未安裝插件")
    If x = 6 Then
    edgePath1 = "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe"
    edgePath2 = "C:\Program Files\Microsoft\Edge\Application\msedge.exe"
    If Dir(edgePath1) <> "" Then edgePath = edgePath1
    If Dir(edgePath2) <> "" Then edgePath = edgePath2
    edgePath = """" & edgePath & """" & " https://github.com/florentbr/SeleniumBasic/releases"
    Call Shell(edgePath, vbNormalFocus)
    End If
Exit Sub
End If

'獲取當前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

Scott090

回復 52# singo1232001

    謝謝大大的細心與貼心。
       SeleniumBasic 的版本好久沒更新了， 一直停留在  v2.0.9.0。

    測試了 #52 樓的程式， 確實成功的更新到 "Stable" 內的 "116.0"的版本。

Scott090

回復 52# singo1232001

   再請教 大大， 下一程式如何填加功能取得 "資料時間 : 2023/08/21 10:44"， 謝謝
  http://forum.twbts.com/viewthread.php?tid=23777&page=4
   Sub Test()
    Dim Driver As New Selenium.ChromeDriver
    Dim ID0 As Object, UL1
    Dim sp, u2%, ar(), i%, w%
    Dim sh As Worksheet
   
    Cells.ClearContents
   
    Set Driver = CreateObject("Selenium.ChromeDriver")
    If Driver Is Nothing Then opDriver
    Driver.AddArgument ("headless")     '不顯示WebPage
'    Driver.Start
    Driver.Get "https://tw.stock.yahoo.com/quote/1101.TW"
   
    Set ID0 = Driver.FindElementByID("qsp-overview-realtime-info")
    Set UL1 = ID0.FindElementsByTag("ul")(1)
    '單列
    sp = Split(UL1.text, Chr(10))
    Cells(1, 1).Resize(UBound(sp) + 1, 1) = Application.Transpose(sp)
   
    '雙列
    u2 = UBound(sp) / 2
    ReDim ar(1 To u2, 1 To 2)
    For i = 0 To UBound(sp) Step 2
        w = w + 1
        ar(w, 1) = sp(i)
        ar(w, 2) = sp(i + 1)
    Next
    Cells(1, 3).Resize(UBound(ar), 2) = ar
End Sub

singo1232001

Driver.Get "https://tw.stock.yahoo.com/quote/1101.TW"

   Do: Set ID0 = Driver.findelementsbyID("main-0-QuoteHeader-Proxy")
        If ID0.Count > 0 Then Exit Do
        Loop
   Do: Set spans = ID0(1).findelementsbytag("span")
        If spans.Count > 0 Then Exit Do
        Loop
    For Each Z In spans
    If Z.Text Like "*開盤*更新*" Then
    時間 = Replace(Z.Text, "開盤 | ", "")
    時間 = "資料時間:" & Replace(時間, " 更新", "")
    Exit For
    End If
    Next

Scott090

回復 55# singo1232001

  經測試後， 時間變數是空白， 不知問題在哪裡
  請 大大 再看看
  謝謝

singo1232001

回復 56# Scott090

Driver.Get "https://tw.stock.yahoo.com/quote/1101.TW"

   Do: Set ID0 = Driver.findelementsbyID("main-0-QuoteHeader-Proxy")
        If ID0.Count > 0 Then Exit Do
        Loop
   Do: Set spans = ID0(1).findelementsbytag("span")
        If spans.Count > 0 Then Exit Do
        Loop
    For Each Z In spans
    If Z.Text Like "*盤*更新*" Then
    sp = Split(Z.Text, " ")
    時間 = "資料時間:" & sp(2) & " " & sp(3)
    Exit For
    End If
    Next

Scott090

回復 57# singo1232001


    有得到正確的資料了：
         時間 =  "資料時間:2023/08/21 14:30"

    非常感恩

t8899

回復 52# singo1232001
path1 = "C:\Users\" & Environ$("username") & "\AppData\Local\SeleniumBasic\Chromedriver.exe"
1.我是裝在上面的資料夾?沒抓到?我就把"C:\Users\" & Environ$("username") & "直接換成實際的路徑才抓到 ?
2.下載有成功, 也有解壓縮，但zip檔沒刪除 ?

singo1232001

回復 59# t8899


    1. 可以  或者自己設個PATH3 ,再DIR 做判斷
2.若不影響  那就放著不管他就好 應該是我沒寫刪除ZIP的功能