12345
返回列表 上一主題 發帖

[發問] 一個用VBA從網頁取得想要資料的寫法~

vesperlee

帖子
15 
主題
7 
精華
0 
積分
69 
點名
0  
作業系統
XP 
軟體版本
SP3 
閱讀權限
20 
性別
男 
註冊時間
2011-7-29 
最後登錄
2021-7-4 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-4-28 15:09 | 只看該作者

[發問] 一個用VBA從網頁取得想要資料的寫法~

本帖最後由 GBKEE 於 2016-1-15 12:59 編輯

麻煩各位大大幫忙，謝謝，感恩~~~~。


請問~~。我想用VBA製作一個BUTTON，當我按下時能從下面網址捉到我指定的資料，並放入excel的儲存格內。該怎麼寫呢！
我只要捉 以下片段的資料
               
                    張數             佔股本比例
董監持股          21,712         6.04%
集保庫存          364,848      101.44%
六日均量          1,834            0.51%  

相關網址
http://jsjustweb.jihsun.com.tw/z/zc/zcx/zcx_6257.asp.htm
http://jsjustweb.jihsun.com.tw///z/zc/zcx/zcxD1.djjs?A=6257"
收藏 分享

vesperlee

帖子
15 
主題
7 
精華
0 
積分
69 
點名
0  
作業系統
XP 
軟體版本
SP3 
閱讀權限
20 
性別
男 
註冊時間
2011-7-29 
最後登錄
2021-7-4 
2#
發表於 2012-5-1 00:54 | 只看該作者
金害~！我只能捉到它的   個股基本資料
為什麼捉不到我要的資料呢？
Private Sub CommandButton1_Click()
Dim webURL As String
webURL = "URL;http://jsjustweb.jihsun.com.tw/z/zc/zcx/zcx_6257.asp.htm"
With ActiveSheet.QueryTables.Add(Connection:=webURL, Destination:=Range("A1"))
        ' xlOverwriteCells 表示覆蓋欄位
        .RefreshStyle = xlOverwriteCells
                .WebTables = "1"
        .Refresh BackgroundQuery:=False
End With
End Sub

TOP

chen_cook

帖子
81 
主題
2 
精華
0 
積分
95 
點名
310  
作業系統
xp 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2012-2-29 
最後登錄
2024-11-6 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章
3#
發表於 2012-5-1 06:56 | 只看該作者
回復 2# vesperlee


    好像與JAVA有關..國泰也是同樣的網頁,無法匯入 Webtable =1 正確是 2或3
    其它證券有相同的資料,去抓它的來套吧!!!
    其它的要求自己想吧!!

TOP

white5168

帖子
90 
主題
16 
精華
0 
積分
114 
點名
0  
作業系統
XP 
軟體版本
sp2 
閱讀權限
20 
性別
男 
註冊時間
2011-7-9 
最後登錄
2018-10-7 
4#
發表於 2012-5-1 07:56 | 只看該作者
本帖最後由 white5168 於 2012-5-1 08:37 編輯

股票名稱及代碼是在網頁載入完成後，才用 JavaScript 動態產生的
所以 Web Query 抓不到
因為網頁資料還單純，建議用VBA開啟網頁後複製表格到excel,再選自己要的部份即可
關於股票代碼的部份請自行修改,
對於抓這樣的資料我都是用python,而且速度上也比VBA快很多
PS:寫程式時請記得加入註解,以養成良好的撰寫習慣,也讓後面的人可以方便學習
  1. Sub Test()
  2.     Const url As String = "http://jsjustweb.jihsun.com.tw/z/zc/zck/zck_6257.asp.htm"
  3.     Cells.Clear
  4.     Set ie = CreateObject("internetexplorer.application") '使用此方式可以免除 "設定引用項目"
  5.     With ie
  6.         .Visible = False 'True為開啟ie, False為不開啟ie
  7.         .Navigate url
  8.         Do While .ReadyState <> 4 '等待網頁開啟
  9.             DoEvents
  10.         Loop
  11.         .ExecWB 17, 2 'Select All
  12.         .ExecWB 12, 2 'Copy selection
  13.         Sheets("Sheet1").Cells.Select
  14.         Range("A1").Activate
  15.         ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
  16.                 False, NoHTMLFormatting:=True
  17.     End With
  18.     Columns("A:B").Delete
  19.     ie.Quit
  20.     MsgBox "資料複製結束"
  21. End Sub
複製代碼
這裡比較會有問題看不懂的地方大概就是ExecWB
我附上MSDN的連結,請自行參考 http://msdn.microsoft.com/en-us/library/aa752087(v=vs.85).aspx

TOP

chen_cook

帖子
81 
主題
2 
精華
0 
積分
95 
點名
310  
作業系統
xp 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2012-2-29 
最後登錄
2024-11-6 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章
5#
發表於 2012-5-1 11:51 | 只看該作者
vesperlee
4樓大大 回覆的不是你指定的網頁,請你自行調整即可達成;因非匯入所以格式會不同就是了!!

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
6#
發表於 2012-5-1 16:42 | 只看該作者
回復 4# white5168
回復 2# vesperlee
請試試看！
  1. Private Sub CommandButton1_Click()
  2.     ' Const url As String = "http://jsjustweb.jihsun.com.tw/z/zc/zck/zck_6257.asp.htm"
  3.     Const url As String = "http://jsjustweb.jihsun.com.tw/z/zc/zcx/zcx_6257.asp.htm"     ' 正確的

  5.     Cells.Clear

  7.     Set ie = CreateObject("internetexplorer.application") '使用此方式可以免除 "設定引用項目"

  9.     With ie
  10.         .Visible = False 'True為開啟ie, False為不開啟ie
  11.         .Navigate url
  12.         Do While .ReadyState <> 4 '等待網頁開啟
  13.         DoEvents
  14.         Loop
  15.         .ExecWB 17, 2 'Select All
  16.         .ExecWB 12, 2 'Copy selection
  17.         Range("A1").Activate
  18.         ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
  19.             False, NoHTMLFormatting:=True
  20.     End With

  22.     Columns("A:B").Delete    ' 將匯入時 A、B 兩欄移除， 原本 C:I 的欄位全部左靠， 成為 A:I
  23.     ie.Quit
  24.     MsgBox "資料複製結束"    ' 離開前顯示一小視窗提醒，按它後即結束。
  25. End Sub
複製代碼

TOP

arksu

帖子
8 
主題
0 
精華
0 
積分
13 
點名
0  
作業系統
WIN7 
軟體版本
2010 
閱讀權限
10 
性別
男 
註冊時間
2012-5-2 
最後登錄
2012-5-6 
7#
發表於 2012-5-3 00:12 | 只看該作者
小弟提供另一個方式用xmlhttp來抓取, 然後在自己解析需要的資料
我之前是用在asp上, vba應該也是可以使用的
Function getHTTPPage(ByVal url As String)

Dim objXmlHttp As Object

objXmlHttp = Server.CreateObject("Microsoft.XMLHTTP")
objXmlHttp.Open("GET", url, False)

objXmlHttp.setRequestHeader("Content-Type", "text/html")
objXmlHttp.setRequestHeader("charset", "BIG5")

objXmlHttp.Send()

getHTTPPage = BytesToBstr(objXmlHttp.ResponseBody, "BIG5")

End Function

Function BytesToBstr(ByVal body() As Byte, ByVal CSet As String)

Dim objStream As Object

objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = 1
objStream.Mode = 3
objStream.Open()
objStream.Write(body)
objStream.Position = 0
objStream.Type = 2
objStream.Charset = CSet

BytesToBstr = objStream.ReadText()

objStream.Close()

End Function

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
8#
發表於 2012-5-3 08:06 | 只看該作者
回復 7# arksu
objXmlHttp.Open("GET", url, False) 等模組無法使用，
可能須要再入其相對 DLL，但我對 VBA 不孰，
請問該如何設定？

TOP

arksu

帖子
8 
主題
0 
精華
0 
積分
13 
點名
0  
作業系統
WIN7 
軟體版本
2010 
閱讀權限
10 
性別
男 
註冊時間
2012-5-2 
最後登錄
2012-5-6 
9#
發表於 2012-5-3 10:44 | 只看該作者
回復 8# c_c_lai


我簡單寫了個範例, 您參考一下

excel一開啟就抓取網頁內容用msgbox秀出來

ademo.zip (14.29 KB)

TOP

yuch8663

帖子
51 
主題
12 
精華
0 
積分
77 
點名
0  
作業系統
windows xp sp3 
軟體版本
excel 2003 2007 
閱讀權限
20 
註冊時間
2010-5-4 
最後登錄
2023-10-31 
10#
發表於 2012-5-8 01:55 | 只看該作者
還是不了解ExecWB 的運作
但是感謝分享!

TOP

        靜思自在 : 能付出愛心就是福，能消除煩惱就是慧。
12345
返回列表 上一主題