返回列表 上一主題 發帖

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

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

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

TOP

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

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

TOP

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

TOP

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

TOP

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

TOP

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

回復  c_c_lai
可加上防錯
GBKEE 發表於 2016-6-10 10:27

如果 xTable.Length 為零,
Until xTable.Length >= 19 會如同死胡同
永遠出不來,所以我改成
If xTable.Length >= 19 Then
     .
    .
End If
仍然是一推
  1. 1             0             1437
  2. 2             0             1438
  3. 3             0             1439
  4. 4             0             1440
  5. 5             0             1441
複製代碼

TOP

回復 8# c_c_lai
可加上防錯
  1. Do
  2.             Set xTable = oHtmldoc.all.tags("TABLE")
  3.             Debug.Print xTable.Length, sn
  4.           ' If xTable.Length >= 19 Then Stop
  5.         Loop Until xTable.Length >= 19
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 6# GBKEE
請教您,有好多回執行到
  1.         Set xTable = oHtmldoc.all.tags("TABLE")
  2.         With Sheets("營運績效")
  3.             '  .Cells.Clear
  4.             For Each E In Array(11, 13, 19) '11,13,19  "TABLE"
  5.                 k = k + 1
  6.                 For R = 0 To xTable(E).Rows.Length - 1
複製代碼
中的   xTable(E).Rows.Length, 便產生如下之錯誤訊息:
  1. 執行階段錯誤 '91'
  2. 沒有設定物件變數或 With 區域變數
複製代碼
查看 oXmlhttp.responseText : "<!DOCTYPE HTML>
<html lang="zh-TW">
<head>
  <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
  <meta http-equiv="X-UA-Compatible" content="I
又看不出有任何狀況, 有時 xTable.length = 0 或  xTable.length =  1 等。

TOP

        靜思自在 : 做該做的事是智慧,做不該做的事是愚癡。
返回列表 上一主題