返回列表 上一主題 發帖

請問如何用 MSXML2.XMLHTTP 捉 臺灣證券交易所 個股月成交資訊

請問如何用 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

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 2# GBKEE


    謝謝 G 大
   再請問 xml.ResponseBody 可以直接貼在工作表嗎
  找了很久都找下到 謝謝

TOP

本帖最後由 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 4# GBKEE


謝謝 G 大
我要做個股成交量有無暴量,程式可要研究一段時間,再請教 G 大
非常感激

TOP

回復 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

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

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

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

  40.     Next
  41. '''''''未測試
  42. End With

  43. End If

  44. End Sub


  45. Sub Ex_1(SS As String, MM As Integer)
  46.     Dim i As Integer, S As Integer, k As Integer, A As Object, II, j
  47. '    工作表3.Select
  48.     With CreateObject("InternetExplorer.Application")
  49.        ' .Visible = True
  50.         .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"
  51.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  52.         Ep .document.getElementsByTagName("table")(1).outerHTML
  53.         On Error Resume Next
  54.         .Quit        '關閉網頁
  55.     End With
  56.    

  57. End Sub
  58. Sub Ex_2(SS As String, SS2 As String, MM As Integer)
  59.     Dim i As Integer, S As Integer, k As Integer, A As Object, II, j
  60. '    工作表3.Select
  61.     With CreateObject("InternetExplorer.Application")
  62.        ' .Visible = True
  63.         .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"
  64.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  65.         Ep .document.getElementsByTagName("table")(1).outerHTML
  66.         On Error Resume Next
  67.         .Quit        '關閉網頁
  68.     End With
  69.         With CreateObject("InternetExplorer.Application")
  70.        ' .Visible = True
  71.         .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"
  72.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  73.         Ep2 .document.getElementsByTagName("table")(1).outerHTML
  74.         On Error Resume Next
  75.         .Quit        '關閉網頁
  76.     End With


  77. End Sub

  78. Sub Ep(S As String)
  79.     Dim D As New DataObject
  80.     'DataObject 物件 在進行轉換動作時,做為格式化文字資料的暫存區域。其也可以暫存和儲存在 DataObject 的文字片段相關的格式。
  81.     '宣告 Dim D As New DataObject '須在工具-> 設定引用項目加入 新增引用 Microsoft Forms 2.0 Object Library ,或於專案 加入一表單即可
  82.     With D
  83.         .SetText S
  84.         .PutInClipboard
  85.         With ActiveSheet
  86.             .UsedRange.Clear
  87.             .Range("a1").Select
  88.             .PasteSpecial Format:="Unicode 文字"
  89.         End With
  90.     End With
  91. End Sub
  92. Sub Ep2(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("j1").Select
  102.             .PasteSpecial Format:="Unicode 文字"
  103.         End With
  104.     End With
  105. End Sub
複製代碼
2014-10-03_232338.jpg

找出量股.rar (38.48 KB)

TOP

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 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

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

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

  42.     Next
  43. '''''''未測試
  44. End With

  45. End If
  46. IE.Quit  '在Sub Index() 程式結束前關閉網頁
  47. End Sub


  48. Sub Ex_1(SS As String, MM As Integer)
  49.     Dim i As Integer, S As Integer, k As Integer, A As Object, II, j
  50. '    工作表3.Select
  51.     With IE
  52.        ' .Visible = True
  53.         .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"
  54.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  55.         Ep .document.getElementsByTagName("table")(1).outerHTML
  56.         On Error Resume Next
  57.         .Quit        '關閉網頁
  58.     End With
  59.    

  60. End Sub
  61. Sub Ex_2(SS As String, SS2 As String, MM As Integer)
  62.     Dim i As Integer, S As Integer, k As Integer, A As Object, II, j
  63. '    工作表3.Select
  64.     With IE
  65.        ' .Visible = True
  66.         .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"
  67.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  68.         Ep .document.getElementsByTagName("table")(1).outerHTML
  69.        ' On Error Resume Next
  70.         .Quit        '關閉網頁
  71.     End With
  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" & SS2 & "/" & SS2 & "_F3_1_8_" & MM & ".php&type=list"
  75.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  76.         Ep2 .document.getElementsByTagName("table")(1).outerHTML
  77.        ' On Error Resume Next
  78.         .Quit        '關閉網頁
  79.     End With


  80. End Sub

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

找出量股2.rar (43.88 KB)

TOP

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

找出量股3.rar (44.65 KB)

TOP

回復 9# wufonna


IE.Quit  '在Sub Index() 程式結束前關閉網頁
沒有IE.Quit ,關閉Excel應用程式後IE還是開啟的,因IE.Visible = False (物件沒有顯示.)
Set IE = Nothing,釋放了變數所結合的物件,Excel應用程式中,可減少佔用的的記憶體
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 手心向下是助人,手心向上是求人;助人快樂,求人痛苦。
返回列表 上一主題