(不定期更新)使用VBA解決 excel web 查詢無法匯入、匯入太慢的股市資料

snare wrote:
只寫重點,其它請自行...(恕刪)

--------------------------------------------------------------------------------------
你好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
師傅, 不好意思還慢慢爬文中。
想先請教您一下一下 :
何時send之後還需送出網址,有的時候又需要有referee url_a,雅虎金融又使用兩次 open "get"。
請問這有有什麼判斷的技巧嗎
謝謝

本想再文章下回覆,不小心又發了新文,不好意思。
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 (軟體),來測試網頁
strainny
是。謝謝師傅!
snare大,
這幾天發現從Yahoo! Finance抓到的Json資料跟網頁的不同
不知道是不是Yahoo!又改了什麼?

這是抓到的資料:

這是網頁實際的資料:
https://finance.yahoo.com/quote/VTI/

文字檔
[點擊下載]
Excel
[點擊下載]

6/27 22:07更新
剛才再試抓資料,竟然都正常了!!
看來是Yahoo! Finance那邊不知道出了什麼問題…
蔬食抗暖化,減碳救地球!
f006116
nija大您好! 想請教依您的程式碼,如果有多檔美股,要如何改用For迴圈來執行呢? 懇請解惑! 謝謝您!!
Snare 大神你好,小弟有根據你 1444 樓步驟及程式碼,
去修改 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
幪面加菲貓
Snare 大神,我找到問題了,把 headless 拿掉跟改 Xpath 就可以抓了,不過偶爾 Chrome 瀏覽器開啟後仍會跑出 "請使用支援JavaScript的瀏覽器開啟本網站"
幪面加菲貓 wrote:
Snare 大神你好...(恕刪)
我跟1455一樣耶~請問Snare 大神

但我的程式沒行chrome.AddArgument ("headless")
其他都一樣
但同網站一直跑出跑出 "請使用支援JavaScript的瀏覽器開啟本網站"

這是怎麼回事?
我看網路說明
https://hackmd.io/@H4RF-OwZTV2RIUC-66D55g/SJu2ih7R5#%E5%90%8C%E6%AD%A5%E5%9F%B7%E8%A1%8Cjavascript

加下面這行可行嗎


.executescript('document.title') '同步執行javascript
幪面加菲貓
加 headless 會跑比較快,之前都可以抓,但前天晚上突然都抓不到,把 headless 拿掉才知道網頁開不起來,跑出"請使用支援JavaScript的瀏覽器開啟本網站"
幪面加菲貓
但我昨天試,把 headless 拿,又大多開的起來,不過還是偶爾會有開不起來的時候,變要手動按網頁重新整理
匯入券商進出排行,有股名看不到,搞好機天還是弄不好,只有到貴站請求幫忙,謝謝


這是我的程式碼
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
snare
21樓 + 1212 樓
瑞尼3653
謝謝snarex樓主解說我巨集概念是0,21及1212樓有看沒懂,這個匯入太慢的股市資料共146篇,看了還是無解,所以請大大們幫我修改程式碼
瑞尼3653 wrote:
匯入券商進出排行,有股名看不到,搞好機天還是弄不好,只有到貴站請求幫忙,謝謝










(2024-07-23 23:40 更新,補上檔案)
[點擊下載]
感謝snare樓主幫忙寫程式碼,可能電腦版本不同,我執行完有些亂碼,不像
snare樓主那麼OK,從下午4點到現在,整整8小時,還是沒摸懂這些程式碼
,再繼續研究,再次感謝snare樓主幫忙。
snare
請回1458樓下載附件測試
報告snare樓主,下載附件依舊是部分亂碼如圖,是我電腦的問題。
我在研究學習看看,謝謝snare樓主。

snare
把比較長的那行改成這樣試試replace(split(split(Table(i).Cells(j).innerhtml,"GenLink2stk('")(1),"');")(0),"','","")
snare
如果還不行,請依自己的電腦情況,用split、replace、mid…等等,文字函數,重新處理字串,函數用法,請google。
文章分享
評分
評分
複製連結
請輸入您要前往的頁數(1 ~ 157)

今日熱門文章 網友點擊推薦!