只寫重點，其它請自行...(恕刪)
--------------------------------------------------------------------------------------
你好snare
我上網找的這個可以用嗎?
自動更新chromedriver vba代碼(通常一個月左右google會更新瀏覽器一次)
這樣的寫法是否有錯?
還是有更簡化的寫法呢?
--------------------------------------------------------------------------------------
-------用法如下-------
https://github.com/florentbr/SeleniumBasic/releases
下載
SeleniumBasic-2.0.9.0.exe
更新chrome版本
chrome>說明>關於google chrome
手動第一次更新chromedriver版本
https://chromedriver.chromium.org/
位置C:\Users\xxx\AppData\Local\SeleniumBasic\
安裝並更新後 第一次測試
開始>selenium Basic>Start Chome>跳錯>自動安裝.net fromework>重開機
第二次測試
開始>selenium Basic>Start Chome>click ok to quit
後期引用寫法(避免換電腦還要重設)
set driver = CreateObject("Selenium.ChromeDriver")
------寫法如下------
自動更新chromedriver vba代碼(通常一個月左右google會更新瀏覽器一次)
Sub seleniumOPEN()
'利用error方式判斷selenium是否異常 若有異常err就不是0 就會進入 updataSelenium 的程序抓取新的chromedrive版本
Do
On Error GoTo 0
On Error Resume Next
Set driver = CreateObject("Selenium.ChromeDriver")
Err = 0
driver.Get "https://www.google.com.tw" '一定要加https:// 不然會出現神奇的異常現象
If Err <> 0 Then
driver.Quit
Set driver = Nothing
Call updataSelenium
End If
Loop Until Err = 0
msgbox "完成"
End Sub
Sub updataSelenium()
'先判斷chromedriver在哪個資料夾
path1 = "C:\Users\" & Environ$("username") & "\AppData\Local\SeleniumBasic\Chromedriver.exe"
path2 = "C:\Program Files\SeleniumBasic\Chromedriver.exe"
If Dir(path1) <> "" Then TempDrvFile = path1
'Kill (TempDrvFile) '假如在錯誤的情況下 找到了檔案 那之後將要更新複製覆蓋 避免跳出複製已存在錯誤警告 所以先刪除掉
If Dir(path2) <> "" Then TempDrvFile = path2
'判斷chrome的版本號
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版本號
Set oShell = CreateObject("wscript.shell")
errcode = oShell.Exec(path1 & " --version").StdOut.ReadAll
verarr = Split(errcode, " ")
chrdrv = verarr(1)
dotsarr2 = Split(chrdrv, ".")
leftchrdrv = dotsarr2(0) & dotsarr2(1)
If leftchrver = leftchrdrv Then Exit Sub '利用版本號的前兩位判斷是否同版本
'利用版本號第一位 上官網查詢 當前版本的最終版本號
URL = "https://chromedriver.storage.googleapis.com/LATEST_RELEASE_" & dotsarr(0)
Call objHttp.Open("GET", URL, False)
Call objHttp.Send("")
version_number = objHttp.responseText
dotsarr3 = Split(version_number, ".")
leftversion_no = dotsarr3(0) & dotsarr3(1)
download_url = "https://chromedriver.storage.googleapis.com/" + version_number + "/chromedriver_win32.zip"
'利用取得的版本號 取得下載網址 並開啟chromedriver.zip下載頁面
Call objHttp.Open("GET", download_url, False)
Call objHttp.Send("")
'開啟adodb接收下載壓縮檔 並放入selenium的資料夾
Set fileStream = CreateObject("ADODB.Stream")
With fileStream
.Open
.Type = 1 'adTypeBinary
.Write objHttp.responseBody
.Position = 0
.SaveToFile "C:\Users\" & Environ$("username") & "\AppData\Local\SeleniumBasic\chromedriver.zip", 2 'adSaveCreateOverWrite 'adSaveCreateOverWrite
.Close
End With
'解壓縮 會先將舊版的刪除 才解壓縮
Set oApp = CreateObject("Shell.Application")
If Dir(path1) <> "" Then Kill path1
oApp.Namespace("C:\Users\" & Environ$("username") & "\AppData\Local\SeleniumBasic\").CopyHere _
oApp.Namespace("C:\Users\" & Environ$("username") & "\AppData\Local\SeleniumBasic\chromedriver.zip").Items
'全部完成後 會回到上一個sub 並重新判斷是否版本錯誤
End Sub
strainny wrote:
何時send之後還需送出網址，有的時候又需要有referee url_a，雅虎金融又使用兩次 open "get"。
請問這有有什麼判斷的技巧嗎
1451樓的程式碼沒什麼問題，要自動下載更新 chromedriver 就是這麼麻煩
沒什麼好簡化的，寫法有很多種，相關範例很多
可google chromedriver auto update vba
除非只在1台電腦使用，那路徑判斷那些可以拿掉
另一種方式是，直接停掉chrome的自動更新，這樣chromedriver也就不用換版本了
referee ，是因為網頁需要知道從那裡跑來這個網頁
open 2次，第一次通常是取得其它資料用的，例如其它網頁的真實連結、key、cookies
第2次，使用取得的資料來模擬上網，透過程式下載資料
判斷的技巧，沒什麼特別的，就是看responsetext有沒有正常傳回資料
沒有就把所需參數，慢慢補到正常為止
進階一點的，可以用 postman (軟體)，來測試網頁
這幾天發現從Yahoo! Finance抓到的Json資料跟網頁的不同
不知道是不是Yahoo!又改了什麼？
這是抓到的資料：
這是網頁實際的資料：
https://finance.yahoo.com/quote/VTI/
文字檔
[點擊下載]
Excel
[點擊下載]
6/27 22:07更新
剛才再試抓資料，竟然都正常了！！
看來是Yahoo! Finance那邊不知道出了什麼問題…
蔬食抗暖化，減碳救地球！
去修改 XPath 之前也都可以抓到該網站選股的結果，
但從昨晚開始就抓不到，出現的錯誤為 " 索引在陣列的界限之外"，
有去看了 XPath，也有修改過，但還是出現一樣的錯誤 " 索引在陣列的界限之外"，
不曉得是不是網頁站長又改了什麼擋程式下載 ?? 還是其實只是 XPath 有變動的問題 ??
請問要如何修改才能成功下載 ??
Sub 營收創新高爬蟲()
Application.screenupdating = False
Dim rw As Integer
Dim cln As Integer
rw = Cells(Rows.Count, 2).End(xlUp).Row
cln = Cells(1, Columns.Count).End(xlToLeft).Column
'清除資料
If rw >= 1 And cln >= 2 Then
Range("B1", Cells(rw, cln)).ClearContents
Else
End If
'定義變數
Dim URL As String
Dim chrome As New Selenium.ChromeDriver
URL = "https://0rz.tw/T4gPu"
chrome.AddArgument ("headless")
'1.連線到網址
chrome.Get URL
'chrome.Window.Maximize
'2.待網頁載入
chrome.Wait 5000
'debug
'Stop
'貼上要複製的表格
chrome.FindElementsByXPath("/html/body/table[2]/tbody/tr[2]/td[3]/div[2]/div/div/table[1]")(1).AsTable.ToExcel Range("B1")
'釋放記憶體
chrome.Quit
Set chrome = Nothing
'7.自動調整欄寬
Columns.AutoFit
Rows.AutoFit
Application.screenupdating = True
End Sub
這是我的程式碼
Sub get_stock(ByVal GetDate As String, ByVal selectType As String)
Sheet3.Select
Cells.Clear
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://fubon-ebrokerdj.fbs.com.tw/z/zg/zgb/zgb0.djhtm?a=5850&b=5854&c=E&e" & GetDate & "&type=" & selectType _
, Destination:=Range("$A$1"))
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://fubon-ebrokerdj.fbs.com.tw/z/zg/zgb/zgb0.djhtm?a=9100&b=9136&c=E&e" & GetDate & "&type=" & selectType _
, Destination:=Range("$L$1"))
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://fubon-ebrokerdj.fbs.com.tw/z/zg/zgb/zgb0.djhtm?a=9100&b=0039003100380065&c=E&e" & GetDate & "&type=" & selectType _
, Destination:=Range("$W$1"))
.Refresh BackgroundQuery:=False
End With
End Sub
瑞尼3653 wrote:
匯入券商進出排行，有股名看不到，搞好機天還是弄不好，只有到貴站請求幫忙，謝謝
(2024-07-23 23:40 更新，補上檔案)
[點擊下載]
內文搜尋
從 APP 打開
X