麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問]VBA抓取.PHP頁問題?? [打印本頁]

作者: chen_cook 時間: 2012-3-2 08:37 標題: [發問]VBA抓取.PHP頁問題??

各位先進
            不才在網路上看到一段抓取櫃買.php的資料,原文如下

Sub Macro1()
Dim i As Integer, j As Integer, k As Integer
URL$ = "http://www.gretai.org.tw/ch/stock/statistics/monthly/st42.php"
With CreateObject("InternetExplorer.Application")
      .Visible = True
      .Navigate URL
      Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
      .Document.all("input_stock_code").Value = 6121 '要查的代碼
      .Document.all(1758).Click <=====巨集執行到此就錯誤,請問這一行是為何意,找了很久查不出是何意
      Application.Wait Now + TimeValue("00:00:02") '等待2秒更新資料
      Set tmp = .Document.getelementsbytagname("table")(79) <==== (79)又是何意??
      k = 1
      Cells(k, 1) = tmp.Rows(0).innertext
      Cells(k, 1).WrapText = False
      For i = 1 To tmp.Rows.Length - 1
         k = k + 1
         For j = 0 To tmp.Rows(i).all.Length - 1
            Cells(k, j + 1) = tmp.Rows(i).Cells(j).innertext
         Next
      Next
      k = k + 1
      Set tmp = .Document.getelementsbytagname("table")(82)<==== (82)又是何意??
      For i = 0 To tmp.Rows.Length - 1
         k = k + 1
         For j = 0 To tmp.Rows(i).all.Length - 1
            Cells(k, j + 1) = tmp.Rows(i).Cells(j).innertext
         Next
   因原網頁就在輸入 6121 就停住了,未能觸發網頁帶出資料,故後續的 table 就無法抓出數據帶入execl,請問先進需如何修改才好..TKS!!

作者: Hsieh 時間: 2012-3-2 09:19

本帖最後由 Hsieh 於 2012-3-2 09:46 編輯

回復 1# chen_cook

With CreateObject("InternetExplorer.Application")
      .Visible = True
      .Navigate URL
      Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
      For Each n In .Document.getelementsbytagname("INPUT") '這個迴圈找到按鈕是第幾個輸入項
         kn = n.Value
         If kn = "查詢" Then Exit For
         s = s + 1
      Next       .Document.all("input_stock_code").Value = 6121 '要查的代碼
      .Document.getelementsbytagname("INPUT")(s).Click '<=====巨集執行到此就錯誤,請問這一行是為何意,找了很久查不出是何意
      Application.Wait Now + TimeValue("00:00:02") '等待2秒更新資料
      Set tmp = .Document.getelementsbytagname("table")(79) '<==== (79)又是何意??79就表示第80個表格
此網頁擷取請測試

Sub Macro1()
Dim i As Integer, j As Integer, k As Integer
URL$ = "http://www.gretai.org.tw/ch/stock/statistics/monthly/st42.php"
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate URL
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
For Each n In .Document.getelementsbytagname("INPUT") '這個迴圈找到按鈕是第幾個輸入項
kn = n.Value
If kn = "查詢" Then Exit For
s = s + 1
Next
.Document.all("input_stock_code").Value = 6121 '要查的代碼
.Document.getelementsbytagname("INPUT")(s).Click '按下查詢紐
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
Application.Wait Now + TimeValue("00:00:02") '等待2秒更新資料
Set tmp = .Document.all("rpt_result").getelementsbytagname("table")(2) '顯示區第3個表格
k = 1
Cells(k, 1) = tmp.Rows(0).innertext
Cells(k, 1).WrapText = False
For i = 1 To tmp.Rows.Length - 1
k = k + 1
For j = 0 To tmp.Rows(i).all.Length - 1
Cells(k, j + 1) = tmp.Rows(i).Cells(j).innertext
Next
Next
k = k + 1
Set tmp = .Document.all("rpt_result").getelementsbytagname("table")(3) '顯示區第4個表格
For i = 0 To tmp.Rows.Length - 1
k = k + 1
For j = 0 To tmp.Rows(i).all.Length - 1
Cells(k, j + 1) = tmp.Rows(i).Cells(j).innertext
Next
Next
.Quit
End With
End Sub

複製代碼

作者: chen_cook 時間: 2012-3-2 15:55

感謝 Hsieh 大大協助解決,初步測試抓到了..

kn = n.Value <==再請教這行是何意,VBA 保留字嗎??

其它大概看的懂.....

作者: Hsieh 時間: 2012-3-2 16:48

回復 3# chen_cook

除了VALUE是屬性外
kn、n並非保留字，這是變數，你自己可以設置任何有意義的字串取代

作者: tsuneng 時間: 2012-7-6 16:11

請問大大, 如要查其他股票,應如何修改.TKS！！

作者: chen_cook 時間: 2012-7-7 05:08

回復 5# tsuneng

.Document.all("input_stock_code").Value = 6121 <--- stockscode$
cells(1, 1) = stockcode$

作者: tsuneng 時間: 2012-7-7 07:19

回復 6# chen_cook

感謝 chen_cook 大大回答, 因是VBA新手在使用上有許多不明白地方, 如方便話可否比照1#,2# 的例子.將CODE 貼上參考. TKS!!!

作者: 沙拉油 時間: 2012-7-10 01:02

如果你不想或不會寫VBA，可以參考這個檔案

作者: chen_cook 時間: 2012-7-10 05:14

回復 7# tsuneng

答案都已回答了!!如果還是想不勞而獲,那就有三線了.:Q

作者: tsuneng 時間: 2012-7-10 11:10

謝謝回答,我不是想"不勞而獲"而是真的不會,真的想學,才會在這提出問題。(如大大也是4年級話，應該會體諒我們這一階段的人,在電腦的知識是有許多不足之處)... 再次謝謝大大回答.

作者: chen_cook 時間: 2012-8-3 04:59

回復 10# tsuneng

我也接近4年級啊!!這是你的說法吧!!

作者: lalalada 時間: 2012-8-3 13:56

本帖最後由 lalalada 於 2012-8-3 13:58 編輯

路過...
順手幫你寫了一個
本來那個有點冗沒有認真看
不知道這是不是你要的?
不過以後還是自己寫會比較好喔:)
使用說明: 1.輸入股票代碼 2.去C槽找同名檔案(.csv)

Sub WrittenByLalalada()
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
code = Application.InputBox(prompt:= "Written by lalalada", Title:="輸入代碼:")
With WinHttpReq
.Open "POST", "http://www.gretai.org.tw/ch/stock/statistics/monthly/download_st42.php", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.Send ("stk_no=" & code)
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.ResponseBody
oStream.SaveToFile ("C:\" & code & ".csv")
oStream.Close
End With
End Sub

複製代碼

剩下的功能就自己改囉!

作者: white5168 時間: 2012-8-3 15:38

可以參考昨天才PO文的 http://forum.twbts.com/thread-7341-1-1.html 裡面有相關的應用

作者: tsuneng 時間: 2012-8-3 22:38

回復 12# lalalada

謝謝大大的熱心分享,努力學習中!!

作者: hotglaygto 時間: 2013-1-14 22:56

謝謝大大的回答我對VBA又更了解了

作者: 水元素 時間: 2013-1-17 16:56

請問大大，
這段程式裡他是如何知道需要的格子是網頁顯示區裡的第幾的表格??
例如: getelementsbytagname("table")(2) '顯示區第3個表格
小的剛學習VBA，若有發問錯誤請見諒!!!謝謝

作者: kimbal 時間: 2013-1-17 22:47

請問大大，
這段程式裡他是如何知道需要的格子是網頁顯示區裡的第幾的表格??
例如: getelementsbytagname ...
水元素發表於 2013-1-17 16:56

要從網頁上的代碼看
.Document.all("rpt_result").getelementsbytagname("table")
VBA上想找的是網頁代碼下 ID 為rpt_result 的數個TABLE:

[attach]13976[/attach]

作者: 水元素 時間: 2013-1-18 11:47

瞭解了!!!

非常謝謝K大的圖文解說~
連data code 都解說了~真的非常清楚!!

作者: gto1208 時間: 2014-2-28 00:46

各位高手您好
http://www.gretai.org.tw/ch/stock/statistics/monthly/st44.php
與上述網站相類，但它輸入時有二個參數，目前找到的參數是"yy"，想請教一下如果是有stk_no與yy，下面send的程式該如何修改呢? 謝謝
.Send ("stk_no=" & code)

作者: heavenweaver 時間: 2014-2-28 09:55

回復 12# lalalada

感謝您提供的vba code，經測試完全正常又不需要開啟IE網頁，值得觀摩學習！

作者: heavenweaver 時間: 2014-2-28 09:59

回復 19# gto1208
如果您是問#12的Sub WrittenByLalalada()，直接複製到您的巨集去執行，就會跳出一個視窗詢問查詢股票代號，直接輸入就好了。

作者: gto1208 時間: 2014-3-3 14:56

heavenweaver您好，

我已有複製#12的Sub WrittenByLalalada()來修改
http://www.gretai.org.tw/ch/stock/statstics/monthly/download_st44.php
上列網址有二個參數，已將程式改寫如下，但年度的send條件還是抓取不到(程式碼如下)，謝謝您

Private Sub CommandButton1_Click()
'宣告變數
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
Dim TMP As Workbook
'清除舊資料
Range("A4:Z2000").Select
Selection.Clear
code = Range("A1").Value '股票代碼
yy = Range("B1").Value '年度
'將資料先存至c糟
With WinHttpReq
'.Open "POST", "http://www.gretai.org.tw/ch/stock/statistics/monthly/download_st44.php", False
.Open "POST", Range("C1").Value, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.Send ("stk_no=" & code & "yy=" & yy)
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.ResponseBody
oStream.SaveToFile ("C:\" & code & ".csv")
oStream.Close
End With
End Sub

複製代碼

作者: heavenweaver 時間: 2014-3-5 09:54

回復 22# gto1208
請參考自行修改。

Sub Macro1()
'
' Macro1 Macro
' Lu 在 2003/2/28 錄製的巨集
'
' 快速鍵: Ctrl+a
'
Dim yy, stock
yy = Application.InputBox(prompt:="請輸入查詢年份(如2013)：", Title:="上櫃統計報表 > 個股月成交資訊")
stock = Application.InputBox(prompt:="請輸入股票代碼(如3260)：", Title:="上櫃統計報表 > 個股月成交資訊")
If yy = "" Then yy = "2013"
If stock = "" Then stock = "3260"
fileIdx = "C:\MyStock\Test\st44_" & stock & ".csv"
myURL = "http://www.gretai.org.tw/ch/stock/statistics/monthly/download_st44.php"
myPar = "yy=" & yy & "&stk_no=" & stock
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
With WinHttpReq
.Open "POST", myURL, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.Send myPar
myURL = .ResponseBody
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
If WinHttpReq.ResponseText = "" Then Exit Sub
oStream.Write WinHttpReq.ResponseBody
On Error Resume Next
Kill fileIdx
On Error GoTo 0
oStream.SaveToFile fileIdx
oStream.Close
End With
End Sub

複製代碼

作者: heavenweaver 時間: 2014-3-5 10:01

回復 22# gto1208
問題在這裡
'將資料先存至c糟
With WinHttpReq
'.Open "POST", "http://www.gretai.org.tw/ch/stock/statistics/monthly/download_st44.php", False
您將這段指令變成remark，正確如下：
.Open "POST", "http://www.gretai.org.tw/ch/stock/statistics/monthly/download_st44.php", False

作者: gto1208 時間: 2014-7-9 16:51

heavenweaver您好，

想向您請教，先前版本依照您的指導已可正常使用，但今日操作時，發現excel資料載不下來，是否相關參數要修改呢? 謝謝您。

Private Sub CommandButton4_Click()
'宣告變數
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
Dim TMP As Workbook
'清除舊資料
Range("F66:Z200").Select
Selection.Clear
code = Range("A1").Value '股票代碼
yy = Range("H4").Value '年度
'將資料先存至c糟
With WinHttpReq
.Open "POST", "http://www.gretai.org.tw/ch/stock/statistics/monthly/download_st44.php", False
.Open "POST", Range("I4").Value, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.Send "stk_no=" & code & "&yy=" & yy '傳股票代碼、年度參數
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.ResponseBody
oStream.SaveToFile ("C:\" & code & "-M.csv")
oStream.Close
End With
End Sub

複製代碼

作者: gto1208 時間: 2014-7-9 21:59

heavenweaver您好，

使用Fiddler工具發現網址有異動，已找到問題了，謝謝您

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)