123
返回列表 上一主題 發帖

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

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
21# 跳轉到 »
發表於 2016-6-13 16:16 | 只看該作者
回復 20# c_c_lai
看上圖106行 form method="post"
說明當你點查詢時是以post傳送請求，所以你不能只用get在網址加參數。
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
22#
發表於 2016-6-13 18:54 | 只看該作者
回復 21# stillfish00
請教應如何解決呢？
困軟我多日了。
謝謝妳！

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
23#
發表於 2016-6-14 09:39 | 只看該作者
回復 20# c_c_lai
可以稍微參考這帖 : http://forum.twbts.com/viewthread.php?tid=15544
  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

  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")

  13.     url = "http://www.twse.com.tw/ch/trading/exchange/MI_MARGN/MI_MARGN.php"
  14.     xDate = Format(Sheets("總表").[B1], "EE/MM/DD")
  15.     sPost = "qdate=" & Replace(xDate, "/", "%2F") & "&selectType=" & TVal(Select_Name)  'urlencode
  16.     Set oXmlhttp = CreateObject("msxml2.xmlhttp")
  17.     Set oHtmldoc = CreateObject("htmlfile")
  18.     With oXmlhttp
  19.         .Open "Post", url, False
  20.         '.setRequestHeader "Connection", "Keep-Alive"   '短時間內多次查詢建議可加這行
  21.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  22.         .setRequestHeader "Content-Length", Len(sPost)
  23.         .Send sPost
  24.         '上面 Open 參數用False(=同步)，可以不用再判斷status
  25.         'Do While .Status <> 200 Or .readyState <> 4: DoEvents: Loop
  26.         oHtmldoc.write .responseText
  27.         'MsgBox .responseText
  28.     End With

  30.     Set xTable = oHtmldoc.ALL.tags("TABLE")
  31.     ' Stop
  32.     '  看看區域變數視窗 xTable 的內容
  33.     Set xTable = oHtmldoc.ALL.tags("TABLE")(0)
  34.     ' Stop
  35.     '  再次看看區域變數視窗 xTable 的內容
  36.     MsgBox xTable.INNERTEXT
  37. End Sub
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
24#
發表於 2016-6-14 11:11 | 只看該作者
回復 23# stillfish00
非常謝謝你！
之前碰到的練習都是接觸到 Get，
所以也沒留意如何去應用 Post 的處哩，
感謝你的指導。   目前
TVal = Array("MS", "ALL", "0049", "0099P", "019919T", "0999", "0999P", "01", "02", "03", _
                "04", "05", "06", "07", "21", "22", "08", "09", "10", _
                "11", "12", "13", "24", "25", "26", "27", "28", "29", _
                "30", "31", "14", "15", "16", "17", "18", "23", "9299", "19", "20", "CB")
目前就只剩下 "ALL" (全部) 的問題仍抓不到，其餘都 OK，或許代碼不對抑或是 . . . . .

我再繼續加油吧。
再次謝謝你囉！

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
25#
發表於 2016-6-15 14:25 | 只看該作者
本帖最後由 GBKEE 於 2016-6-15 14:33 編輯

回復 15# c_c_lai
應運  網頁有流量管制.
1 檔案關閉
2重開檔案,   重啟adsl的連線,執行程式

另設一個要開開關關 goodinfo_合併財報檔案 的檔案
ThisWorkbook 模組的程式碼
  1. Option Explicit
  2. Private Sub Workbook_BeforeClose(Cancel As Boolean)
  3.     Application.Quit
  4. End Sub
  5. Private Sub Workbook_Open()
  6.     Dim App As New Application, xFile As String
  7.     xFile = "D:\goodinfo_合併財報.xls"  ' goodinfo_合併財報程式的檔案
  8.     Application.Visible = False
  9. Re_App:
  10.     With App
  11.         .Visible = True
  12.         .Workbooks.Open (xFile)
  13.     End With
  14.     If App.Visible = False Then
  15.     Set App = Nothing
  16.     GoTo Re_App   
  17.     End If
  18.     ThisWorkbook.Close
  19. End Sub
複製代碼
goodinfo_合併財報檔案 ThisWorkbook 模組的程式碼
  1. Option Explicit
  2. Private Sub Workbook_Open()
  3.     adsl連線   '參考   http://forum.twbts.com/thread-17716-1-1.html 的 adsl連線程式碼
  4.     goodinfo_合併財報
  5. End Sub
  6. Private Sub Workbook_BeforeClose(Cancel As Boolean)
  7.     Application.Quit
  8. End Sub
  9. Sub goodinfo_合併財報()   
  10.     Dim xTable As Object, k As Integer, C As Integer, sn As Double, r As Integer
  11.     Dim url As String, i As Double, E As Variant
  12.     Dim oXmlhttp As Object, oHtmldoc As Object, surl, op, tm
  13.    For Each E In ThisWorkbook.Names
  14.         If E.Name = "報表開始列" Then GoTo xStart
  15.    Next
  16.     ThisWorkbook.Names.Add "報表開始列", 1
  17.     ThisWorkbook.Names.Add "報表開時間", Time
  18.     ThisWorkbook.Activate
  19. xStart:
  20.     Sheets("營運績效").Activate
  21.         With Sheets("營運績效2")
  22.             .UsedRange.Clear
  23.         End With
  24.     For i = [報表開始列] To Sheets("總表").Cells(Rows.Count, 2).End(xlUp).Row '
  25. APP_EX:
  26.         sn = Sheets("總表").Cells(i, 2)
  27.         url = "http://goodinfo.tw/StockInfo/StockBzPerformance.asp?STOCK_ID=" & sn & "&YEAR_PERIOD=10&RPT_CAT=M_YEAR"
  28.         Set oXmlhttp = CreateObject("msxml2.xmlhttp")
  29.         Set oHtmldoc = CreateObject("htmlfile")
  30.         With oXmlhttp
  31.             .Open "Get", url, False
  32.             .Send
  33.             oHtmldoc.write .responseText
  34.         End With
  35.         Set xTable = oHtmldoc.all.tags("TABLE")
  36.            '*********可觀看 流量被管制 ************************************
  37.            Sheets("營運績效").Cells(i, 1).Resize(, 3) = Array(xTable.Length, sn, Time)
  38.            Sheets("營運績效").Cells(i, 1).Select
  39.            '************************************************************
  40.               If xTable.Length = 0 Then
  41.                  ThisWorkbook.Names.Add "報表開始列", i
  42.                  ThisWorkbook.Close True
  43.               End If
  44.             With Sheets("營運績效2")
  45.             For Each E In Array(11, 13, 19) '11,13,19  "TABLE"
  46.                 k = k + 1
  47.                 For r = 0 To xTable(E).Rows.Length - 1
  48.                 For C = 0 To xTable(E).Rows(r).Cells.Length - 1
  49.                     .Cells(k, C + 1) = xTable(E).Rows(r).Cells(C).innertext
  50.                 Next
  51.                 k = k + 1
  52.                 Next
  53.             Next
  54.         End With
  55.     Next
  56.     ThisWorkbook.Names("報表開始列").Delete
  57.     MsgBox "費時 " & Application.Text(Time - [報表開時間], "M分S秒") & " Finished Complete!"
  58. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
26#
發表於 2016-6-15 15:42 | 只看該作者
回復 25# GBKEE
謝謝您！
#15 ~ #20 間的提問，最後我是以
  1. .Open "Post", url, False
複製代碼
取代了
  1. .Open "Get", url, False
複製代碼
才得以解決 "&select2=" & TVal(Select_Name)
的參數引入問題。
可是卻出現寫入之文字部分是一堆亂碼，
所以才會再丟出 由網頁取得的資料，不知道要如何同步編碼成正確之中文碼回傳
相關的提問。上網查看了 Google/亂碼 的討論
好似不太搭嘎，難以解題。
謝謝您費心地回復。
上述 "如何同步編碼" 我亦有加入補充，並附上檔案
再次謝謝您了！麻煩您！

TOP

        靜思自在 : 有心就有福，有願就有力，自造福田，自得福緣。
123
返回列表 上一主題