返回列表 上一主題 發帖

股票資料匯入,程式執行有問題

回復 10# c_c_lai
XP IE8 用 6#的程式碼,沒加上防錯的程式碼
沒有你所說的錯誤
  1. http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=1437 &YEAR_PERIOD=10&RPT_CAT=M_YEAR
  2. 24       1437
  3. http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=1438 &YEAR_PERIOD=10&RPT_CAT=M_YEAR
  4. 24       1438
  5. http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=1439 &YEAR_PERIOD=10&RPT_CAT=M_YEAR
  6. 24       1439
  7. http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=1440 &YEAR_PERIOD=10&RPT_CAT=M_YEAR
  8. 24       1440
  9. http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=1441 &YEAR_PERIOD=10&RPT_CAT=M_YEAR
  10. 24       1441
  11. http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=1442 &YEAR_PERIOD=10&RPT_CAT=M_YEAR
  12. 24       1442
  13. http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=1443 &YEAR_PERIOD=10&RPT_CAT=M_YEAR
  14. 24       1443
  15. http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=1444 &YEAR_PERIOD=10&RPT_CAT=M_YEAR
  16. 24       1444
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 11# GBKEE
明天我再來仔細測試一下。
不信邪,結果依然有錯誤信息:

TOP

回復 11# GBKEE
附上檔案堤供測試:
歷史股價更新.rar (27.88 KB)

TOP

回復 13# c_c_lai
這網頁有流量管制.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復  c_c_lai
這網頁有流量管制.
GBKEE 發表於 2016-6-11 07:05

沒錯,它還會丟出訊息:
  1. 網站偵測到您的瀏覽量異常, 目前暫時關閉服務, 請稍後再重新查詢
複製代碼
謝謝您囉!

TOP

回復 14# GBKEE
額外再請教您,在附上之『融資融券與上市當沖.xls』
選紐『融資融券  III』對應的「Sub 融資融券3()」,
url 裡為何我一直抓不到正確的 selectType 對應值?
在「Sub 融資融券2()」使用 .QueryTables.Add() 的方式
即可正確取得?
謝謝您!
融資融券與上市當沖.rar (109.56 KB)
TWSE 臺灣證券交易所.rar (5.29 KB)

TOP

本帖最後由 GBKEE 於 2016-6-12 15:02 編輯

回復 16# c_c_lai


   
url 裡為何我一直抓不到正確的 selectType 對應值?
  網頁的建置我沒入門,所以我也在摸索中


  .getElementsByName:      getElements 複數-> 物件的集合
  .getElementsBytagName:  getElements 複數-> 物件的集合
  .ALL.tags:                     tags 複數-> 物件的集合
  .getElementById :          getElement  單數 ->單一的物件
  1. Set xTable = oHtmldoc.ALL.tags("TABLE")
  2. Stop
  3. '看看區域變數視窗 xTable 的內容
  4.     Set xTable = oHtmldoc.ALL.tags("TABLE")(0)
  5. Stop
  6. '再次看看區域變數視窗 xTable 的內容
  7.     MsgBox xTable.INNERTEXT
複製代碼
附檔中有許多相同的程式碼.,,,,,,,,,,,
  1.      TVal = Array("MS", "", "0049", "0099P", "019919T", "0999", "0999P", "01", "02", "03", _
  2.                 "04", "05", "06", "07", "21", "22", "08", "09", "10", _
  3.                 "11", "12", "13", "24", "25", "26", "27", "28", "29", _
  4.                 "30", "31", "14", "15", "16", "17", "18", "23", "9299", "19", "20", "CB")
  5.     '**************************
  6.    If .ComboBox1.Value = "Select Name" Then
  7.             MsgBox ("您尚未選擇「產業類別」,請於" & vbCrLf & "確認後再次點選『開啟網頁』," & vbCrLf & "謝謝您!")
  8.             Exit Sub
  9.         End If        
  10.         For cts = 0 To UBound(lst)
  11.             If lst(cts) = .[D1] Then select2 = TVal(cts): Exit For
  12.         Next cts
複製代碼
可以整合一下
  1. Option Explicit
  2. Const MyUrl = "http://www.twse.com.tw/ch/trading/exchange/MI_MARGN/MI_MARGN.php"
  3. Private Sub Workbook_Open()
  4.     Dim oHtmldoc, op, cts
  5.     Set oHtmldoc = CreateObject("htmlfile")
  6.     With CreateObject("msxml2.xmlhttp")
  7.         .Open "Get", MyUrl, False
  8.         .Send
  9.         Do While .Status <> 200 Or .readyState <> 4: DoEvents: Loop
  10.         oHtmldoc.write .responseText
  11.     End With
  12.     Set op = oHtmldoc.all.tags("select")("selectType")
  13.     With Sheets("總表").ComboBox1
  14.         .Clear
  15.         For cts = 0 To op.Length - 1
  16.                 .AddItem                                             '清單方塊或下拉式清單方塊中加入一個項目
  17.                 .List(.ListCount - 1, 0) = op(cts).Text   ' 第1欄,最多9欄
  18.                 .List(.ListCount - 1, 1) = op(cts).Value ' 第2欄,最多9欄
  19.         Next
  20.         .Value = "Select Name"  '.List(0)  '0: 信用交易統計, 1:全部,2: 封閉式基金......
  21.     End With
  22. End Sub
複製代碼
  1. Private Function Select_Name() As Integer
  2.     With Sheets("總表").ComboBox1
  3.         If .ListIndex = -1 Then MsgBox ("您尚未選擇「產業類別」,請於" & vbCrLf & "確認後再次點選『開啟網頁』," & vbCrLf & "謝謝您!")
  4.         Select_Name = .ListIndex
  5.     End With
  6. End Function
複製代碼
  1. Sub 融資融券2()
  2.     Dim qdate As String, select2 As String
  3.     'Dim TVal(), cts As Integer
  4.     If Select_Name = -1 Then
  5.         Exit Sub
  6.      Else
  7.         With Sheets("總表")
  8.             qdate = Format(.[B1], "EE/MM/DD")
  9.             With .ComboBox1
  10.             select2 = .List(.ListIndex, 1)
  11.             End With
  12.         End With
  13.      End If   
  14.     With Sheets("融資_融券")
  15.         .Select
  16.         .Cells.Clear
  17.     End With
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 17# GBKEE
好建議收到了,抽時間再來試試整合後之效果,
原本裡面的主題模組是各自獨立的應用測試,
突發奇想,如果同一主題均分別使用不同處理方式,
如 CreateObject("InternetExplorer.Application")、
.QueryTables.Add()、以及 CreateObject("msxml2.xmlhttp")
與 CreateObject("htmlfile") 搭配應用等,並觀察它們同時外部
帶入參數、如 url = "http://www.twse.com.tw/ch/trading/exchange/MI_MARGN/MI_MARGN.php?qdate=" & xDate & "&selectType=" & select2
或內部處理方式,如 .Document.ALL("input_date").Value = xDate
.Document.ALL("select2").SelectedIndex = i  以及內部觸發之
.Document.ALL("login_btn").Click 等的不同應用,從其各別的角度
來評估執行成效的。並藉此亦可啟發大家的知的權益及多方之應用。
謝謝您囉!

TOP

回復 17# GBKEE
測試用 (已套用您建議之函數)
  1. Sub Test()
  2.     Dim xTable As Object, k As Integer, C As Integer, R As Integer        '  , sn As Integer
  3.     Dim url As String, cts As Integer, E As Variant, xDate As String      '  , rc As Integer
  4.     Dim oXmlhttp As Object, oHtmldoc As Object, select2 As String         '  , tm
  5.     Dim TVal() As Variant
  6.    
  7.     If Select_Name = -1 Then Exit Sub
  8.     TVal = Array("MS", "ALL", "0049", "0099P", "019919T", "0999", "0999P", "01", "02", "03", _
  9.                 "04", "05", "06", "07", "21", "22", "08", "09", "10", _
  10.                 "11", "12", "13", "24", "25", "26", "27", "28", "29", _
  11.                 "30", "31", "14", "15", "16", "17", "18", "23", "9299", "19", "20", "CB")
  12.    
  13.     xDate = Format(Sheets("總表").[B1], "EE/MM/DD")
  14.     url = "http://www.twse.com.tw/ch/trading/exchange/MI_MARGN/MI_MARGN.php?qdate=" & xDate & "&selectType=" & TVal(Select_Name)
  15.     'url = "http://www.twse.com.tw/ch/trading/exchange/MI_MARGN/MI_MARGN.php?qdate=" & xDate & "&selectType=" & Select_Name
  16.     'url = "http://www.twse.com.tw/ch/trading/exchange/MI_MARGN/MI_MARGN.php?qdate=" & xDate & "&selectType=水泥工業"
  17.     Set oXmlhttp = CreateObject("msxml2.xmlhttp")
  18.     Set oHtmldoc = CreateObject("htmlfile")
  19.     With oXmlhttp
  20.         .Open "Get", url, False
  21.         .Send
  22.         
  23.         Do While .Status <> 200 Or .readyState <> 4: DoEvents: Loop
  24.         
  25.         oHtmldoc.write .responseText
  26.         'MsgBox .responseText
  27.     End With
  28.    
  29.     Set xTable = oHtmldoc.ALL.tags("TABLE")
  30.     ' Stop
  31.     '  看看區域變數視窗 xTable 的內容
  32.     Set xTable = oHtmldoc.ALL.tags("TABLE")(0)
  33.     ' Stop
  34.     '  再次看看區域變數視窗 xTable 的內容
  35.     MsgBox xTable.INNERTEXT
  36. End Sub

  37. Private Function Select_Name() As Integer
  38.     With Sheets("總表").ComboBox1
  39.         If .ListIndex = -1 Then MsgBox ("您尚未選擇「產業類別」,請於" & vbCrLf & "確認後再次點選『開啟網頁』," & vbCrLf & "謝謝您!")
  40.         Select_Name = .ListIndex    '  Select_Name = -1,0,1,2,3,4,5,6,7,8,9,.....39
  41.     End With
  42. End Function
複製代碼

TOP

回復 17# GBKEE

TOP

        靜思自在 : 忘功不忘過,忘怨不忘恩。
返回列表 上一主題