bioleon69 wrote:
有兩個東西擋住
token跟uri
不知道怎麼找出連結
938樓回答過了，方法同631樓
差別只在一個要放在header裡面，一個放在send參數
================================================================
'取得集保戶股權分散表(新版網頁)，最新一筆資料
'連續(重新)下載、資料庫、除錯…等方法，請參考686樓
'TOKEN取得方式(說明)，請參考631樓
'686樓舊版程式可正常使用，不需更新
Sub Get_TDCC_NEW_Web()
Dim HTMLsourcecode As Object, GetXml As Object, Url As String, url_a As String, temp() As String, ttt As Double
Dim StockNo As String, scaDate, SYNCHRONIZER_TOKEN As String, SYNCHRONIZER_URI As String
Set HTMLsourcecode = CreateObject("htmlfile")
Set GetXml = CreateObject("msxml2.xmlhttp")
ttt = Timer
Url = "https://www.tdcc.com.tw/portal/zh/smWeb/qryStock"
With GetXml
.Open "POST", Url, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", Url
.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
.send
HTMLsourcecode.body.innerhtml = .responsetext
SYNCHRONIZER_TOKEN = HTMLsourcecode.getElementById("SYNCHRONIZER_TOKEN").Value
SYNCHRONIZER_URI = HTMLsourcecode.getElementById("SYNCHRONIZER_URI").Value
'==================
StockNo = "2330"
'get all date
scaDate = Split(Trim(Split(Split(HTMLsourcecode.body.innertext, "資料日期")(1), "證券代號")(0)), " ")
Debug.Print UBound(scaDate), scaDate(0), scaDate(5), scaDate(10)
url_a = "SYNCHRONIZER_TOKEN=" & SYNCHRONIZER_TOKEN & "&SYNCHRONIZER_URI=" & SYNCHRONIZER_URI & "&method=submit&firDate=" & scaDate(0) & "&scaDate=" & scaDate(0) & "&sqlMethod=StockNo&stockNo=" & StockNo & "&stockName="
'==================
.Open "POST", Url, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Referer", Url
.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
.send (url_a)
HTMLsourcecode.body.innerhtml = .responsetext
Set Table = HTMLsourcecode.all.tags("table")(1).Rows
ReDim temp(1 To Table.Length, 1 To Table(2).Cells.Length)
With Sheets("工作表1")
For i = 0 To Table.Length - 1
For j = 0 To Table(i).Cells.Length - 1
temp(i + 1, j + 1) = Table(i).Cells(j).innertext
Next j
Next i
.Cells.Clear
.Range("a1").Resize(UBound(temp(), 1), UBound(temp(), 2)) = temp()
.Columns.AutoFit
End With
End With
MsgBox "證券代號：" & Split(Split(HTMLsourcecode.body.innertext, "證券代號：")(1), "序")(0) & vbNewLine & Timer - ttt & "秒"
Set HTMLsourcecode = Nothing
Set GetXml = Nothing
End Sub
[點擊下載]
