[發問] 股價VBA的檔案無法更新

abc9gad2016

版上前輩好，自從逐筆交易開始後，我的EXCEL抓取股票即時價就無回應

原本以為是YAHOO STOCK那邊網址有變，所以更新了網址

但結果還是一樣...想請版上高手幫忙看看是什麼原因造成無法更新的 謝謝

股VBA.rar (39.08 KB)

下載次數: 25

2020-3-31 14:49

PS.此檔案是版主准大所分享的，我只做了一些自己想要的欄位變更  萬分感謝

准提部林

我的作業環境還是 XP+office 2000
對yahoo及大部份網頁沒輒,
看有否其他大大代為修改程式,
或許傳訊息給超版來看看~~

n7822123

回復 1# abc9gad2016

Yahoo可能有改網頁編寫格式

下面程式的ST2的字串在Yahoo網頁原始碼已經找不到了

原程式是用ST1字串與ST2字串擷取一段需要的原始碼資訊~

坦白說，我不大喜歡他解字串的方式......看的很累...........

原程式如下:


Sub 擷取資料()
Dim ReTxt, i&, ARR, BRR(9), V As Currency, GetTime$
uTxtStr = ""
Call 取得網頁原始碼: If uTxtStr = "" Then Exit Sub
'-----------------------------------------------------
GetStr = ""
ST1 = "href=""/q/bc?s=" & uRng & """>"
ST2 = "<a href=""/q/ts?s=" & uRng & """>成交明細</a>"
GetStr = 擷取文字碼(uTxtStr, ST1, ST2):  If GetStr = "" Then Exit Sub


把上面程式的ST2部分，改成如下就可以了

ST2 = "<a href=""/q/ts?s=" & uRng & """>成交彙整</a>"

明細  >>>  彙整



附上我自己做的部分如下 ，舊板Excel不支援超過7層的函數，公式會失效

但是不影響網路抓資料，我抓的網站是Hi投資，我自認寫的檢短多了~應該吧!



理財策略V1.0.rar (91.56 KB)

下載次數: 36

2020-4-1 00:48

abc9gad2016

回復 3# n7822123


   感謝大大分享~另外原版的依照大大所說的變更也能成功抓取了 謝謝

bhsm

回復 3# n7822123
感謝n7822123大的分享

GBKEE

回復 4# abc9gad2016
試試看

1. Sub 更新全部()
   
2.     Call 共用參照: If uRow <= 0 Then Exit Sub
   
3.     uHead(0, 0) = "※更新中.............."
   
4.     uHead(2, 12).Resize(uRow).ClearContents
   
5.     For Each uRng In uClmnNo
   
6.         uRng(1, 3).Resize(1, 10).ClearContents
   
7.         網頁元素_htmlfile uRng
   
8.         Beep
   
9.     Next
   
10.     uHead(0, 0) = "※更新時間：" & Format(Now, "yyyy/mm/dd hh:mm:ss")
    
11.     ThisWorkbook.Save
    
12. End Sub
    
13. 
    
14. Sub 網頁元素_htmlfile(uRng As Range)
    
15.     Dim oXmlhttp As Object, oHtmldoc As Object, surl As String, E As Object, i As Integer
    
16.     Set oXmlhttp = CreateObject("msxml2.xmlhttp")
    
17.     Set oHtmldoc = CreateObject("htmlfile")
    
18.    If uRng = "" Then Exit Sub
    
19.     surl = "https://tw.stock.yahoo.com/q/q?s=" & uRng
    
20.     With oXmlhttp
    
21.         .Open "Get", surl, False
    
22.         .Send
    
23.         oHtmldoc.write .responseText
    
24.     End With
    
25.     On Error GoTo Ne    '處理股票代碼不存在時程式的出錯
    
26.      With oHtmldoc
    
27.         Set E = .all.tags("TABLE")(2).Rows(1).Cells  '股票代碼不存時  E Is Nothing
    
28.         '** .Rows(1).Cells 網頁表格的內容 ****
    
29.         uRng.Cells(1, 2) = Split(E(0).INNERTEXT, vbCrLf)(0)     '去掉換行後的字元
    
30.         uRng.Cells(1, 2) = Replace(uRng.Cells(1, 2), uRng, "") '消除股票代碼
    
31.         For i = 2 To E.Length - 2
    
32.                If i = 2 + 3 Then
    
33.                     uRng.Cells(1, i + 1) = Mid(E(i).INNERTEXT, 2) '**消除漲跌的符號**
    
34.                 Else
    
35.                     uRng.Cells(1, i + 1) = E(i).INNERTEXT
    
36.                 End If
    
37.         Next
    
38.         uRng.Cells(1, i + 1) = E(1).INNERTEXT  '交易時間
    
39.     End With
    
40. Ne:
    
41.   uRng.Interior.Color = IIf(E Is Nothing, vbRed, xlAutomatic) '
    
42.     Set oXmlhttp = Nothing  '
    
43.     Set oHtmldoc = Nothing
    
44. End Sub

複製代碼

imingho

回復 1# abc9gad2016

附檔是我修改過的檔案，可以下載試看看。
_金千里股票監看系統.zip (31.9 KB)

下載次數: 48

2020-4-2 15:53