Board logo

標題: 請問如何用 MSXML2.XMLHTTP 捉 臺灣證券交易所 個股月成交資訊 [打印本頁]
作者: wufonna    時間: 2014-9-30 23:08     標題: 請問如何用 MSXML2.XMLHTTP 捉 臺灣證券交易所 個股月成交資訊

請問如何用 MSXML2.XMLHTTP 捉

臺灣證券交易所 個股月成交資訊
http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/STOCK_DAYMAIN.php

的資料

謝謝

例如：
http://social.msdn.microsoft.com/Forums/en-US/bd0ee306-7bb5-4ce4-8341-edd9475f84ad/excel-2007-use-vba-to-download-save-csv-from-url?forum=isvvba
作者: GBKEE    時間: 2014-10-1 08:41

回復 1# wufonna
試試看
  1. Option Explicit
  2. Sub Ex下載CSV()
  3.     Dim xml As Object
  4.     Dim stream
  5.     Dim URL As String     '目的網址
  6.     Set xml = CreateObject("Microsoft.XMLHTTP") '用來取得網頁資料
  7.     Set stream = CreateObject("ADODB.stream")   'ADODB.stream   '用來儲存二進位檔案
  8.     URL = "http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/STOCK_DAY_print.php?genpage=genpage/Report201408/201408_F3_1_8_2485.php&type=csv"
  9.     xml.Open "get", URL, 0
  10.     xml.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  11.     xml.send
  12.     With stream
  13.         .Open
  14.         .Type = 1
  15.         .write xml.ResponseBody
  16.         'SaveToFile:檔案名稱已存在時會有錯誤,須先刪除已存在的檔案名稱
  17.         If Dir("D:\2485.CSV") <> "" Then Kill "D:\2485.CSV"
  18.         .SaveToFile ("D:\2485.CSV")
  19.         .Close
  20.     End With
  21. End Sub
複製代碼
作者: wufonna    時間: 2014-10-1 18:30

回復 2# GBKEE


    謝謝 G 大
   再請問 xml.ResponseBody 可以直接貼在工作表嗎
  找了很久都找下到 謝謝
作者: GBKEE    時間: 2014-10-1 20:07

本帖最後由 GBKEE 於 2014-10-2 05:50 編輯

回復 3# wufonna
換一個方式
  1. Option Explicit
  2. Sub Ex_個股月成交資訊()
  3.     Dim i As Integer, S As Integer, k As Integer, A As Object, ii, j
  4.     With CreateObject("InternetExplorer.Application")
  5.        ' .Visible = True
  6.         .Navigate "http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/STOCK_DAY_print.php?genpage=genpage/Report201408/201408_F3_1_8_2485.php&type=list"
  7.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  8.         Ep .document.getElementsByTagName("table")(1).outerHTML
  9.         .Quit        '關閉網頁
  10.     End With
  11. End Sub
  12. Sub Ep(S As String)
  13.     Dim D As New DataObject
  14.     'DataObject 物件 在進行轉換動作時，做為格式化文字資料的暫存區域。其也可以暫存和儲存在 DataObject 的文字片段相關的格式。
  15.     '宣告 Dim D As New DataObject '須在工具-> 設定引用項目加入 新增引用 Microsoft Forms 2.0 Object Library ,或於專案 加入一表單即可
  16.     With D
  17.         .SetText S
  18.         .PutInClipboard
  19.         With ActiveSheet
  20.             .UsedRange.Clear
  21.             .Range("a1").Select
  22.             .PasteSpecial Format:="Unicode 文字"
  23.         End With
  24.     End With
  25. End Sub
複製代碼
作者: wufonna    時間: 2014-10-1 22:11

回復 4# GBKEE


謝謝 G 大
我要做個股成交量有無暴量，程式可要研究一段時間，再請教 G 大
非常感激
作者: wufonna    時間: 2014-10-4 00:26

回復 4# GBKEE

G 大 您好
我想將工作表1的個股找出出量股 放再工作表2中
是否用太多資源了 出了如下圖的錯誤

為什麼 set CreateObject("InternetExplorer.Application") = Nothing 不可用

請教 G 大如何修改
謝謝
  1. Option Explicit
  2. Sub Index()
  3. Dim i As Integer, I2 As Integer
  4. Dim x, y, XX, YY, ZZ
  5. Dim k
  6. Const AA As Integer = 5
  7. 工作表3.Activate
  8. '工作表3.Select
  9. If Int(Split(Date, "/")(2)) < 6 Then '是不過6天運算，不過加上月份
  10. Application.ScreenUpdating = False
  11. With 工作表1
  12.     k = 2
  13.     For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
  14.         I2 = .Cells(i, 1).Value
  15.         Debug.Print I2

  17.         Call Ex_2(Split(Date, "/")(0) & Format((Split(Date, "/")(1) - 1), "00"), Split(Date, "/")(0) & Format((Split(Date, "/")(1)), "00"), I2)
  18.    
  19.     y = 工作表3.Range("J" & 工作表3.Rows.Count).End(xlUp).Row - 3 - 1 ' 這月份要用的平均數
  20.     x = AA - y
  21.     YY = 工作表3.Range("J" & 工作表3.Rows.Count).End(xlUp).Row - y
  22.     XX = 工作表3.Range("A" & 工作表3.Rows.Count).End(xlUp).Row - x + 1
  23.     ZZ = (WorksheetFunction.Sum(工作表3.Cells(YY, 11).Resize(y)) + WorksheetFunction.Sum(工作表3.Cells(XX, 2).Resize(x))) / AA
  24.     On Error Resume Next

  26.     If 工作表3.Cells(工作表3.Range("J" & 工作表3.Rows.Count).End(xlUp).Row, 11) > ZZ * 5 Then
  27.         工作表2.Cells(k, 1).Resize(, 2).Value = .Cells(i, 1).Resize(, 2).Value
  28.            k = k + 1
  29.         Debug.Print k
  30.     End If
  31.    
  32.    
  33.     Next
  34. End With
  35. Application.ScreenUpdating = True

  37. Else
  38. With 工作表1
  39. ''''''''未測試
  40.     For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
  41.    
  42. Call Ex_1(Split(Date, "/")(0) & Format((Split(Date, "/")(1)), "00"), I2)

  44.     Next
  45. '''''''未測試
  46. End With

  48. End If

  50. End Sub


  53. Sub Ex_1(SS As String, MM As Integer)
  54.     Dim i As Integer, S As Integer, k As Integer, A As Object, II, j
  55. '    工作表3.Select
  56.     With CreateObject("InternetExplorer.Application")
  57.        ' .Visible = True
  58.         .Navigate "http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/STOCK_DAY_print.php?genpage=genpage/Report" & SS & "/" & SS & "_F3_1_8_" & MM & ".php&type=list"
  59.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  60.         Ep .document.getElementsByTagName("table")(1).outerHTML
  61.         On Error Resume Next
  62.         .Quit        '關閉網頁
  63.     End With
  64.    

  66. End Sub
  67. Sub Ex_2(SS As String, SS2 As String, MM As Integer)
  68.     Dim i As Integer, S As Integer, k As Integer, A As Object, II, j
  69. '    工作表3.Select
  70.     With CreateObject("InternetExplorer.Application")
  71.        ' .Visible = True
  72.         .Navigate "http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/STOCK_DAY_print.php?genpage=genpage/Report" & SS & "/" & SS & "_F3_1_8_" & MM & ".php&type=list"
  73.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  74.         Ep .document.getElementsByTagName("table")(1).outerHTML
  75.         On Error Resume Next
  76.         .Quit        '關閉網頁
  77.     End With
  78.         With CreateObject("InternetExplorer.Application")
  79.        ' .Visible = True
  80.         .Navigate "http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/STOCK_DAY_print.php?genpage=genpage/Report" & SS2 & "/" & SS2 & "_F3_1_8_" & MM & ".php&type=list"
  81.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  82.         Ep2 .document.getElementsByTagName("table")(1).outerHTML
  83.         On Error Resume Next
  84.         .Quit        '關閉網頁
  85.     End With


  88. End Sub

  90. Sub Ep(S As String)
  91.     Dim D As New DataObject
  92.     'DataObject 物件 在進行轉換動作時，做為格式化文字資料的暫存區域。其也可以暫存和儲存在 DataObject 的文字片段相關的格式。
  93.     '宣告 Dim D As New DataObject '須在工具-> 設定引用項目加入 新增引用 Microsoft Forms 2.0 Object Library ,或於專案 加入一表單即可
  94.     With D
  95.         .SetText S
  96.         .PutInClipboard
  97.         With ActiveSheet
  98.             .UsedRange.Clear
  99.             .Range("a1").Select
  100.             .PasteSpecial Format:="Unicode 文字"
  101.         End With
  102.     End With
  103. End Sub
  104. Sub Ep2(S As String)
  105.     Dim D As New DataObject
  106.     'DataObject 物件 在進行轉換動作時，做為格式化文字資料的暫存區域。其也可以暫存和儲存在 DataObject 的文字片段相關的格式。
  107.     '宣告 Dim D As New DataObject '須在工具-> 設定引用項目加入 新增引用 Microsoft Forms 2.0 Object Library ,或於專案 加入一表單即可
  108.     With D
  109.         .SetText S
  110.         .PutInClipboard
  111.         With ActiveSheet
  112. '            .UsedRange.Clear
  113.             .Range("j1").Select
  114.             .PasteSpecial Format:="Unicode 文字"
  115.         End With
  116.     End With
  117. End Sub
複製代碼
作者: GBKEE    時間: 2014-10-4 05:51

回復 6# wufonna
Set  CreateObject("InternetExplorer.Application")=Nothing
不是變數是一個實際的物件.
Nothing 關鍵字是用來將一個物件變數從一個實際的物件裏分離開來。使用 Set 陳述式可指定 Nothing 給物件變數。

修改看看
  1. Option Explicit
  2. Dim IE As Object  '宣告為這模組的私用變數(這模組中的程序可呼叫的變數)
  3. Sub Index()
  4. Dim i As Integer, I2 As Integer
  5. Dim x, y, XX, YY, ZZ
  6. Dim k
  7. Set IE = CreateObject("InternetExplorer.Application")
  8. Const AA As Integer = 5
  9. 工作表3.Activate
  10. '工作表3.Select
  11. With 工作表1
  12. ''''''''未測試
  13.     For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row   
  14. Call Ex_1(Split(Date, "/")(0) & Format((Split(Date, "/")(1)), "00"), I2)
  15.     Next
  16. '''''''未測試
  17. End With
  18. End If
  19. IE.Quit  '在Sub Index() 程式結束前關閉網頁
  20. End Sub
  21. Sub Ex_1(SS As String, MM As Integer)
  22.     Dim i As Integer, S As Integer, k As Integer, A As Object, II, j
  23. '    工作表3.Select
  24.     With IE
  25.        ' .Visible = True
  26.        On Error Resume Next
  27.         .Navigate "http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/STOCK_DAY_print.php?genpage=genpage/Report" & SS & "/" & SS & "_F3_1_8_" & MM & ".php&type=list"
  28.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  29.         Ep .document.getElementsByTagName("table")(1).outerHTML
  30.        ' .Quit        '關閉網頁
  31.     End With
  32. End Sub
複製代碼
作者: wufonna    時間: 2014-10-4 11:36

本帖最後由 wufonna 於 2014-10-4 11:39 編輯

回復 7# GBKEE
G 大大 您好
我改了程式 執行了如下錯誤
請問如何改進 謝謝
  1. Option Explicit
  2. Dim IE As Object  '宣告為這模組的私用變數(這模組中的程序可呼叫的變數)
  3. Sub Index()
  4. Dim i As Integer, I2 As Integer
  5. Dim x, y, XX, YY, ZZ
  6. Dim k
  7. Set IE = CreateObject("InternetExplorer.Application")
  8. Const AA As Integer = 5
  9. 工作表3.Activate
  10. '工作表3.Select
  11. If Int(Split(Date, "/")(2)) < 6 Then '是不過6天運算，不過加上月份
  12. Application.ScreenUpdating = False
  13. With 工作表1
  14.     k = 2
  15.     For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
  16.         I2 = .Cells(i, 1).Value
  17.         Debug.Print I2

  19.         Call Ex_2(Split(Date, "/")(0) & Format((Split(Date, "/")(1) - 1), "00"), Split(Date, "/")(0) & Format((Split(Date, "/")(1)), "00"), I2)
  20.    
  21.     y = 工作表3.Range("J" & 工作表3.Rows.Count).End(xlUp).Row - 3 - 1 ' 這月份要用的平均數
  22.     x = AA - y
  23.     YY = 工作表3.Range("J" & 工作表3.Rows.Count).End(xlUp).Row - y
  24.     XX = 工作表3.Range("A" & 工作表3.Rows.Count).End(xlUp).Row - x + 1
  25.     ZZ = (WorksheetFunction.Sum(工作表3.Cells(YY, 11).Resize(y)) + WorksheetFunction.Sum(工作表3.Cells(XX, 2).Resize(x))) / AA
  26.     On Error Resume Next

  28.     If 工作表3.Cells(工作表3.Range("J" & 工作表3.Rows.Count).End(xlUp).Row, 11) > ZZ * 5 Then
  29.         工作表2.Cells(k, 1).Resize(, 2).Value = .Cells(i, 1).Resize(, 2).Value
  30.            k = k + 1
  31.         Debug.Print k
  32.     End If
  33.    
  34.    
  35.     Next
  36. End With
  37. Application.ScreenUpdating = True

  39. Else
  40. With 工作表1
  41. ''''''''未測試
  42.     For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
  43.    
  44. Call Ex_1(Split(Date, "/")(0) & Format((Split(Date, "/")(1)), "00"), I2)

  46.     Next
  47. '''''''未測試
  48. End With

  50. End If
  51. IE.Quit  '在Sub Index() 程式結束前關閉網頁
  52. End Sub


  55. Sub Ex_1(SS As String, MM As Integer)
  56.     Dim i As Integer, S As Integer, k As Integer, A As Object, II, j
  57. '    工作表3.Select
  58.     With IE
  59.        ' .Visible = True
  60.         .Navigate "http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/STOCK_DAY_print.php?genpage=genpage/Report" & SS & "/" & SS & "_F3_1_8_" & MM & ".php&type=list"
  61.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  62.         Ep .document.getElementsByTagName("table")(1).outerHTML
  63.         On Error Resume Next
  64.         .Quit        '關閉網頁
  65.     End With
  66.    

  68. End Sub
  69. Sub Ex_2(SS As String, SS2 As String, MM As Integer)
  70.     Dim i As Integer, S As Integer, k As Integer, A As Object, II, j
  71. '    工作表3.Select
  72.     With IE
  73.        ' .Visible = True
  74.         .Navigate "http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/STOCK_DAY_print.php?genpage=genpage/Report" & SS & "/" & SS & "_F3_1_8_" & MM & ".php&type=list"
  75.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  76.         Ep .document.getElementsByTagName("table")(1).outerHTML
  77.        ' On Error Resume Next
  78.         .Quit        '關閉網頁
  79.     End With
  80.         With IE
  81.        ' .Visible = True
  82.         .Navigate "http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/STOCK_DAY_print.php?genpage=genpage/Report" & SS2 & "/" & SS2 & "_F3_1_8_" & MM & ".php&type=list"
  83.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  84.         Ep2 .document.getElementsByTagName("table")(1).outerHTML
  85.        ' On Error Resume Next
  86.         .Quit        '關閉網頁
  87.     End With


  90. End Sub

  92. Sub Ep(S As String)
  93.     Dim D As New DataObject
  94.     'DataObject 物件 在進行轉換動作時，做為格式化文字資料的暫存區域。其也可以暫存和儲存在 DataObject 的文字片段相關的格式。
  95.     '宣告 Dim D As New DataObject '須在工具-> 設定引用項目加入 新增引用 Microsoft Forms 2.0 Object Library ,或於專案 加入一表單即可
  96.     With D
  97.         .SetText S
  98.         .PutInClipboard
  99.         With ActiveSheet
  100.             .UsedRange.Clear
  101.             .Range("a1").Select
  102.             .PasteSpecial Format:="Unicode 文字"
  103.         End With
  104.     End With
  105. End Sub
  106. Sub Ep2(S As String)
  107.     Dim D As New DataObject
  108.     'DataObject 物件 在進行轉換動作時，做為格式化文字資料的暫存區域。其也可以暫存和儲存在 DataObject 的文字片段相關的格式。
  109.     '宣告 Dim D As New DataObject '須在工具-> 設定引用項目加入 新增引用 Microsoft Forms 2.0 Object Library ,或於專案 加入一表單即可
  110.     With D
  111.         .SetText S
  112.         .PutInClipboard
  113.         With ActiveSheet
  114. '            .UsedRange.Clear
  115.             .Range("j1").Select
  116.             .PasteSpecial Format:="Unicode 文字"
  117.         End With
  118.     End With
  119. End Sub
複製代碼
作者: wufonna    時間: 2014-10-4 12:02

回復 7# GBKEE
謝謝 G 大大
程式如圖的錯誤
我註解了副程式的
  '    .Quit        '關閉網頁
主程式加  Set IE = Nothing
就可了
非常感謝 G 大大
我再改看看 不懂再請教 大大
^_^
作者: GBKEE    時間: 2014-10-4 14:45

回復 9# wufonna


IE.Quit  '在Sub Index() 程式結束前關閉網頁
沒有IE.Quit ,關閉Excel應用程式後IE還是開啟的,因IE.Visible = False (物件沒有顯示.)
Set IE = Nothing,釋放了變數所結合的物件,Excel應用程式中,可減少佔用的的記憶體
作者: wufonna    時間: 2014-10-4 22:48

回復 10# GBKEE

感謝 GBKEE  大大
讓我學到很多知識
謝謝
^_^



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