返回列表 上一主題 發帖

取得網頁原始碼的資料

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

TOP

查詢時另存csv檔 

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.47 KB)

只能提供如上範例,其它請自行套用∼∼

TOP

這裡有超板的解法,參考:
http://forum.twbts.com/thread-15067-1-7.html

TOP

回復 5# pideo

參考這帖,只能約略說明:
http://forum.twbts.com/thread-15544-1-1.html

TOP

        靜思自在 : 口說一句好話,如口出蓮花;口說一句壞話如口吐毒蛇。
返回列表 上一主題