返回列表 上一主題 發帖

[分享] 使用 XMLHTTP + ADODB.Stream 查詢保戶股權分散表

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2015-11-9 21:05 | 只看該作者

[分享] 使用 XMLHTTP + ADODB.Stream 查詢保戶股權分散表

本帖最後由 准提部林 於 2015-11-9 21:18 編輯

使用 XMLHTTP + ADODB.Stream 查詢保戶股權分散表
　
＜題由＞　
取得網頁原始碼的資料
http://forum.twbts.com/thread-15528-1-1.html
　
雖然作了回覆，特再花個時間做個MEMO，
除了為自己做個備忘錄，也希望讓網友多個參考處。
　
＜註一＞　
無法使用.responseText取得原始碼文字，肇因可能為網頁編碼的關係，
取出的文字為〔亂碼〕，故造成程式的錯誤中斷；
因此借用 ADODB.Stream 為中介，以〔二進位〕方式取出原始碼，
可用〔XMLHTTP　ADODB.Stream〕為關鍵字 GOOGLE 一下，
有相當多的資料可參考，個人也是一知半解（知其然）而已，
為免做錯誤的解釋，請自行去探索，
也期待有心的專家來補充益眾。　
　
＜註二＞　
本範例主要網址為：http://www.tdcc.com.tw/smWeb/QryStock.jsp，
XMLHTTP 並未對網頁〔控件〕做查詢參數的輸入操作，
因此，程式碼必須含有〔查詢參數〕，例如：〔日期〕〔股票代碼〕，
經多次嚐試，不得其門而入，拼半天也只是：
SCA_DATE=日期&StockNo=股票代碼∼∼但行不通！！！
後想到超板有答過此相關題，找了一下，在這裡：
http://forum.twbts.com/thread-15067-1-7.html
　
網址完整後綴如下：
SCA_DATE=日期&SqlMethod=StockNo&StockNo=股票代碼&StockName=&sub=%ACd%B8%DF
　
這串文字怎來的？期待超板的開示∼∼　
　
＜註三＞　
XMLHTTP〔post．get〕的差異！
ｇｅｔ：第一次執行，譬如向客戶要求傳真，須等文件傳送，所以花些時間；
　　　　第二次以後的執行，因文件已存在，就直接取用，時間快很多；
　　　　但那是〔舊資料〕，可能與最新的正本有差異。
ｐｏｓｔ則每次都要求傳送，以取得最新的資料。
　
另外可以在網址後面加入亂數，例如：
URL = "http://www.tdcc.com.tw/smWeb/QryStock.jsp" & "?" & Rnd
使每次連結的網址視為不同，也可達到取得最新內容的目的，但並非所有網址可如此。
　
＜註四＞　
一般若輸入錯誤的網址，應會傳回錯誤，或傳回未就緒訊息，
但有時網頁雖未進入指定的目的頁，但會自動跳至其主頁或首頁，
此時 XMLHTTP 仍然可以正常傳回文字，只是並非所要的內容，
所以還是要注意。
　
＜後記＞　
對網頁存取仍是門外人，僅如上淺薄注文，間或有誤有漏，請自行參酌；
以下的程式碼及範例也僅供參考套用，恕不為網友個別提供客製修改；
希望路過專家不吝指導，為此帖漏誤之處做更精確的大補帖，謝謝！　

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub 取出日期清單()
Dim XML, URL$, TT
[A:A].ClearContents
URL = "http://www.tdcc.com.tw/smWeb/QryStock.jsp" & "?" & Rnd
Set XML = CreateObject("Microsoft.XMLHTTP")
XML.Open "post", URL, False
XML.send
If XML.Status = 200 Then
　With CreateObject("ADODB.Stream")
　　　　.Open
　　　　.Type = 1
　　　　.Write XML.ResponseBody
　　　　.Position = 0
　　　　.Type = 2
　　　　.Charset = "BIG5"
　　　　TT = .ReadText
　　　　.Close
　End With
　TT = Replace(TT, "</option><option >", "_")
　TT = Split(TT, "</option>")(0)
　TT = Split(TT, "<option >")(1)
　TT = Split(TT, "_")
　[A1].Resize(UBound(TT) + 1) = Application.Transpose(TT)
End If
Set XML = Nothing
End Sub

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub 保戶股權分散表查詢()
Dim XML, URL$, TT, vDate, vNo, vFile$, X, PP$
vDate = [F1]: vNo = [F2]: vFile = vNo & "_" & vDate & ".csv"
URL = "http://www.tdcc.com.tw/smWeb/QryStock.jsp?SCA_DATE=" & vDate & _
　　　"&SqlMethod=StockNo&StockNo=" & vNo & "&StockName=&sub=%ACd%B8%DF"
Set XML = CreateObject("Microsoft.XMLHTTP")
XML.Open "post", URL, False
XML.send
If XML.Status = 200 Then
　With CreateObject("ADODB.Stream")
　　　　.Open
　　　　.Type = 1
　　　　.Write XML.ResponseBody
        
　　　　.Position = 0
　　　　.Type = 2
　　　　.Charset = "BIG5"
　　　　TT = .ReadText
　　　　.Close
        
　　　　PP = "<table cellspacing=0 cellpadding=0 width=""100%"" border=0>"
　　　　X = Split(TT, PP)
　　　　If UBound(X) < 3 Then Exit Sub
　　　　TT = Replace(X(3) & PP & X(4), "集保戶股權分散表", "")
　
　　　　.Open
　　　　.Writetext TT
　　　　.SaveToFile ThisWorkbook.Path & "\" & vFile, 2
　　　　.Close
　　　　Beep
　End With
End If
Set XML = Nothing
End Sub
　
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
附件下載：
20151108-01(保戶股權分散表查詢).rar (10.48 KB)
收藏 分享

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
7#
發表於 2015-11-14 11:00 | 只看該作者
回復 6# no3-taco

對字碼編碼的知識並不充分, 頂多要用時上網找現成的, 能套則套,
一般公司資料應用上,  用的機會並不多!

貴解及stillfish00大大的程式都是正規, 謝謝提供有用的知識~

TOP

no3-taco

帖子
41 
主題
0 
精華
0 
積分
79 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2014-4-1 
最後登錄
2016-2-17 
6#
發表於 2015-11-14 06:35 | 只看該作者
回復 5# 准提部林
參考stillfish00大大的規則寫的，提供不一樣的寫法
沒有比對很多字，有寫錯的地方指導一下
  1. Function Urlbig5(Ub5 As String) As String  'uni轉big5
  2. Dim a() As Byte: a = StrConv(Ub5, 128)
  3. For I = 0 To UBound(a)
  4.     If Chr(a(I)) Like "[A-Za-z0-9]" Then  
  5.         Urlbig5 = Urlbig5 & Chr(a(I))
  6.     Else
  7.         Urlbig5 = Urlbig5 & "%" & Hex(a(I))
  8.     End If
  9. Next I
  10. End Function

  12. Function UrlUto8x(Uu As String) As String  'uni轉utf-8
  13. With CreateObject("ADODB.Stream")
  14.     .Type = 2
  15.     .Charset = "utf-8"
  16.     .Open
  17.     .writetext Uu '內容
  18.     .Position = 0
  19.     .Type = 1
  20.     Dim ax() As Byte: ax = .read
  21.     .Close
  22. End With

  24. For I = 3 To UBound(ax) '保留BOM 3改1
  25.     UrlUto8x = UrlUto8x & "%" & Hex(ax(I))
  26. Next I
  27. End Function
複製代碼
1

評分人數

    • 准提部林: 與stillfish00大大不同的寫法來對照, 更容易 ...金錢 + 5

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
5#
發表於 2015-11-13 18:31 | 只看該作者
回復 4# stillfish00


=UrlEncode_BIG5("台泥") → "%A5x%AAd" 　直接儲存格公式即得，好用！

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
4#
發表於 2015-11-13 18:11 | 只看該作者
本帖最後由 stillfish00 於 2015-11-13 18:25 編輯

回復 3# stillfish00
拼拼湊湊推導出來的編碼邏輯，若有發現錯誤請指點下，謝謝。
  1. Function UrlEncode_BIG5(s As String) As String
  2.     Dim c As Integer
  3.     Dim hiByte As Byte, loByte As Byte
  4.     Dim ar
  5.    
  6.     For i = 1 To Len(s)
  7.         c = Asc(Mid(s, i, 1))
  8.         hiByte = (c And &HFF00&) / &H100
  9.         loByte = c And &HFF&
  10.         If hiByte = 0 Then ar = Array(loByte) Else ar = Array(hiByte, loByte)
  11.         
  12.         For Each x In ar
  13.             If (x >= &H30 And x <= &H39) Or _
  14.                 (x >= &H41 And x <= &H5A) Or _
  15.                 (x >= &H61 And x <= &H7A) Then
  16.                 UrlEncode_BIG5 = UrlEncode_BIG5 & Chr(x)
  17.             Else
  18.                 UrlEncode_BIG5 = UrlEncode_BIG5 & "%" & Hex(x)
  19.             End If
  20.         Next
  21.     Next
  22. End Function
複製代碼
UrlEncode_BIG5("台泥") => "%A5x%AAd"
1

評分人數

    • 准提部林: 看來雖簡單, 不容易呀! 收下了, 謝謝!金錢 + 5
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
3#
發表於 2015-11-12 10:58 | 只看該作者
本帖最後由 stillfish00 於 2015-11-12 11:00 編輯

回復 1# 准提部林
自己也對網頁擷取自行摸索一段時間，以下是個人見解提供參考:
首先，我們要與(網頁)伺服器溝通，是透過對瀏覽器的操作(例如重新整理或網頁上的送出按鈕)
來發出"請求"(request)封包，經由網路傳給伺服器，
伺服器再經由網路返回"響應"(response)給瀏覽器。

這個"請求"封包中包含了 url , method , status , header , body 等等
GET和POST就是請求的方法(method)中最常見的兩種，
最大不同的地方在於：
GET是直接把要傳遞的參數附加在url字串後方
POST是把要傳遞的參數放在body。

假設
    sURL = "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
    sArg = "SCA_DATE=20151106&SqlMethod=StockNo&StockNo=1101&StockName=&sub=查詢"
    sEncodeArg = UrlEncode(sArg)     
    'UrlEncode : 自訂Function，
    '編碼完 sEncodeArg = "SCA_DATE=20151106&SqlMethod=StockNo&StockNo=1101&StockName=&sub=%ACd%B8%DF"

GET附加的文字要經過Url Encode
POST放到body的內容可選擇不同編碼方式，但要在header中說明
所以XML通常會這樣寫:
  1. 'GET
  2. .Open "GET" , sURL & "?" & sEncodeArg
  3. .send
複製代碼
  1. 'POST
  2. .Open "POST" , sURL
  3. .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  4. .setRequestHeader "Content-Length", Len(sEncodeArg)
  5. .send (sEncodeArg)
複製代碼
1. 版主提到的取到舊資料，應是緩存(cache的關係)
    可考慮上述GET的send前加上
        .setRequestHeader "Pragma", "no-cache"
    或
        .setRequestHeader "Cache-Control", "no-cache"
    告訴網路中的節點(如proxy), 不要用你自己的cache資料返回給我
    URL加亂數也是類似道理，因為URL變了不容易有相同URL的cache資料
    (但亂數到同一個值還是有機會取到舊的)

2. URL Encode  Function，網路上找到的一般應該多是 for "utf-8"的，
無法把 "sub=查詢" 轉成 "sub=%ACd%B8%DF"  (所以當初有人問chrome為何無法decode)
http://www.mytju.com/classCode/tools/urlencode_big5.asp
這網站有線上的，可以知道for "big5" url encode 的結果
但不知道編碼邏輯，不好做成自定的 function
1

評分人數

    • 准提部林: 真是菁華出類, 倍增添益, 謝謝!金錢 + 5
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2015-11-10 07:23 | 只看該作者
回復 1# 准提部林
請問java 的網頁可以抓的下來嗎？
請問 如何用 vba 點擊網頁查詢
1

評分人數

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 閒人無樂趣，忙人無是非。
返回列表 上一主題