用你個方法後
部xp機已可以下載data了
個人積分：0分
文章編號：69569590
個人積分：2分
文章編號：69672210
https://goodinfo.tw/StockInfo/ShowBuySaleChart.asp?STOCK_ID=2377&CHT_CAT=DATE,
即時運算只從中間出一段到最後(如下), 原因不知是否是"很抱歉，您的瀏覽器不支援 html5 所設計之繪圖功能，請改用 IE9、google chrome 或 firefox 等瀏覽器，以支援此功能。"
謝謝樓主教了非常多
== 程式
Sub getstockbuysale()
Dim URL, HTMLsourcecode, GetXml
Set HTMLsourcecode = CreateObject("htmlfile")
Set GetXml = CreateObject("msxml2.xmlhttp")
'範例網址yahoo 中華電信 股價
'URL = "https://tw.stock.yahoo.com/q/q?s=2412"
URL = "https://goodinfo.tw/StockInfo/ShowBuySaleChart.asp?STOCK_ID=2377&CHT_CAT=DATE"
With GetXml
.Open "GET", URL, False
'以下這3行避免抓到暫存資料
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
.send
'把傳回值轉成標準htmlfile，這裡就要解釋一下了
HTMLsourcecode.body.innerhtml = .responsetext
'.responsetext 傳回值如下
'要從這些文字中找出資料，要用一堆搜尋、判斷，程式會變的很長
Debug.Print .responsetext
'但如果轉成標準htmlfile，就很簡單了
'可以用tags方法，很容易的取出網頁中的某個物件，程式變短
'這裡是取出表格編號6，tags("table")(6)，'看網頁原始碼就可以知道是那一個表格
'如果不會看，很簡單，從0開始試
'如果只是要取出表格，基本上這個範例幾乎所有非java網頁都適用
Debug.Print HTMLsourcecode.body.innerhtml
Set Table = HTMLsourcecode.all.tags("table")(23).Rows
'把要的表格轉成一個table陣列
'Debug.Print Table
'table.length 算出表格有幾列
For i = 2 To Table.Length - 1
'table(i).cells.length 算出每列表格有幾欄
For j = 0 To Table(i).Cells.Length - 1
'把每格資料照順序填入工作表中
'這裡是用比較簡單的寫法，缺點是比較慢
'如果要快一點，需用陣列一次寫入全部資料
'使用方式請參考1樓、45樓、71樓、107樓的程式碼改寫
'ActiveSheet.Cells(i + 1, j + 1) = Table(i).Cells(j).innertext
Sheets("BUYSALE").Cells(i + 1, j + 1) = Table(i).Cells(j).innertext
Next j
Next i
End With
'釋放記憶體
Set HTMLsourcecode = Nothing
Set GetXml = Nothing
End Sub
=====即時運算
個人積分：3107分
文章編號：69678329
yuhuahsiao wrote:
我安裝了XP Pos 更新, 但無法完整下載
https://goodinfo.tw/StockInfo/ShowBuySaleChart.asp?STOCK_ID=2377&CHT_CAT=DATE,
即時運算只從中間出一段到最後(如下), 原因不知是否是"很抱歉，您的瀏覽器不支援 html5 所設計之繪圖功能，請改用 IE9、google chrome 或 firefox 等瀏覽器，以支援此功能。"...(恕刪)
我試了您改寫的程式碼，很正常喔，一字未改
可以試看看如下
一、升級到ie8(有些xp還在ie6)
二、也許xp pos沒裝好
yuhuahsiao wrote:
原因不知是否是"很抱歉，您的瀏覽器不支援 html5 所設計之繪圖功能，請改用 IE9、google chrome 或 firefox 等瀏覽器，以支援此功能。"...(恕刪)
用xp 的 ie8 開現在的網頁，本來就會出現這種問題，是正常的
但不會影響vba的執行(如果您 xp pos 有裝好的話)
即時運算視窗中的"您的瀏覽器不支援 html5 所設計之繪圖功能"，那個訊息不用管它
用firefox for xp ，就可以正常打開網頁
個人積分：2分
文章編號：69688577
我發現"集保戶股權分散表查詢"沒辦法下載
用snare大的版本也不行
我發現我可以把日期下載下來
但是要載資料的時後都是空的，沒有timeout
去查Request URL及 Form Data都沒有變可以延用下面的
.Open "POST", "https://www.tdcc.com.tw/smWeb/QryStockAjax.do", False
url_a = "scaDates=" & temp(k) & "&scaDate=" & temp(k) & "&SqlMethod=StockNo&StockNo=" & stockid & "&radioStockNo=" & stockid & "&StockName=&REQ_OPR=SELECT&clkStockNo=" & stockid & "&clkStockName="
但是send url_a之後 都得不到東西
google很久還是找不到答案 所以我又回來爬文了，發現我都有跟上，也改網址了
不知道snare大大有沒有遇到一樣的問題??
個人積分：2分
文章編號：69689310
我解掉了.....發現改成下面這樣就好了.....
With GetXml
.Open "POST", "https://www.tdcc.com.tw/smWeb/QryStockAjax.do?" & url_a, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", "https://www.tdcc.com.tw/smWeb/QryStock.jsp"
.setRequestHeader "User-Agent", "Mozilla/6.0 (compatible; MSIE 6.0; Windows NT 5.0)"
' .send url_a
.send
個人積分：3107分
文章編號：69692563
個人積分：1分
文章編號：69757745
個人積分：3107分
文章編號：69757870
tmwcykixe wrote:
之前都能更新，107/8/18更新時資料停留在107/7/13，日期及資料都未能下載，於http後加了"s"就更新成功...(恕刪)
找到原因了，就如您所說的 s 的問題我一直在測試資料庫版本，因為集保戶股權分散表，是7個交易曰更新一次
所以這幾天測試都正常(程式自動跳到離線資料了)，沒發現網頁改了一個網址
這一頁改版了
http://www.tdcc.com.tw/smWeb/QryStock.jsp
改成這樣
https://www.tdcc.com.tw/smWeb/QryStock.jsp
但是資料那一頁，網址沒改
https://www.tdcc.com.tw/smWeb/QryStockAjax.do
而且更大的問題是，重新下載上傳的版本
和我自己電腦裡的328、358樓的程式，比對後才發現
我的程式是https 的，po 的範例是 http，忘了是什麼時候改的，沒有上傳修正
難怪我怎麼試都正常
不好意思，誤會printf.tw、tmwcykixe，您們這2位了
…有空再修正
個人積分：3107分
文章編號：69758239
查詢網頁改版，網址改了一個字
查詢後的網址不變
所以
328樓(舊版)，線上版的，日期會無法下載，程式無法正確執行
358樓(舊版)，線上+離線版，程式可正常執行，但無法更新離線資料
2個程式，都只有改一個字，想看改了什麼，請回328樓、358樓看內文
又忘了把張數變化改成股數變化
，請自行除1000(358樓有註解如何修改)，或把“張”改成“股”'=================================
'20180828 更新，網頁表格換位置了，(7、8)，改成(6、7)
stockname = HTMLsourcecode.all.tags("table")(6).Rows(0).innertext
Set Table = HTMLsourcecode.all.tags("table")(7).Rows
328樓，修正版
附加壓縮檔: 201808/mobile01-d1d906dca8800c3ca01d0fa27ba281e2.zip
358樓，修正版(資料庫不用重新下載)
附加壓縮檔: 201808/mobile01-e7e3872d1bf6b428378665fbe8be8a80.zip
個人積分：2分
文章編號：69766760
你好! 想從
https://www.cnyes.com/twstock/a_price4.aspx 去抓起 OTC 歷史日期的資料如2018-08-10 一直抓2018-08-17 TSE資料
能否請snare大抽空 指導 謝謝
Sub getdata()
Dim HTMLsourcecode, url, Url_a, TempArray(), Table, Title
Set HTMLsourcecode = CreateObject("htmlfile")
Sheets("sheet1").Cells.Clear
TSEOTC = "OTC"
startday = "2018-08-10"
url = "https://www.cnyes.com/twstock/a_price4.aspx"
Url_a = "code=" & "ctl00$ContentPlaceHolder1$D1=" & TSEOTC & "&ctl00$ContentPlaceHolder1$D3=" & startday
MsgBox Url_a
ttt = Timer
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", url, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", url
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send Url_a
HTMLsourcecode.body.innerhtml = .responseText
Title = stock & HTMLsourcecode.getelementbyid("ctl00_ContentPlaceHolder1_UpdatePanel1").innertext
Set Table = HTMLsourcecode.all.tags("table")(1).Rows
ReDim TempArray(Table.Length - 1, Table(2).Cells.Length - 1)
' Set Table = HTMLsourcecode.all.tags("table")(1).Rows
' ReDim TempArray(Table.Length - 1, Table(2).Cells.Length - 1)
For i = 0 To Table.Length - 1
For j = 0 To Table(i).Cells.Length - 1
TempArray(i, j) = Table(i).Cells(j).innertext
If (i > 0 And j = 5) Then
With Sheets("sheet1")
If TempArray(i, j) > 0 Then .Range(.Cells(i + 1, 5), .Cells(i + 1, 7)).Font.Color = -16776961
If TempArray(i, j) < 0 Then .Range(.Cells(i + 1, 5), .Cells(i + 1, 7)).Font.Color = -11489280
End With
End If
Next j
Next i
With Sheets("sheet1")
.Range(.Cells(1, 1), .Cells(Table.Length, Table(2).Cells.Length)) = TempArray()
End With
End With
MsgBox Title & vbNewLine & "日期" & startday & vbNewLine & vbNewLine & "資料筆數" & Table.Length - 1 & vbNewLine & "使用時間" & Round(Timer - ttt, 2) & "秒", vbOKOnly, "下載完成"
Set HTMLsourcecode = Nothing
Set Table = Nothing
Erase TempArray()
End Sub
