突然想到台新下載比較特別,就順便搬來這一篇
是當初在這一篇
https://www.mobile01.com/topicdetail.php?f=511&t=6020568
好奇匯率如何計算,加上NWCS這位專家,不厭其煩的指導,練習做的半成品

為什麼說是半成品
因為下載資料、計算、排序都對了,但最後卡在手續費是不固定的
沒建資料庫的話,無法正確列入手續費,手續費也是重要的成本之一
所以結果只能參考,真的拿來用的話會賠錢的
,只能拿來玩不過這樓的重點是下載資料,不在計算
其中台新的下載方式比較特別
台新的 .responsetext 如下圖
有一堆 DOCUMENT.WRITELN('網頁原始碼'),文字全部都是Unicode

整理資料前,要先把 .responsetext變成標準html格式,Unicode轉碼
DOCUMENT.WRITELN(''),說穿了沒什麼特別
用vba來說,就像把文字寫到檔案中而已,再去執行那個檔案
原理差不多就像下面這個範例
Sub test()
Open "c:\test.bat" For Output As #1
Print #1, "echo off"
Print #1, "echo 獎大很帥"
Print #1, "echo 體重秘密"
Print #1, "pause"
Close #1
Shell "c:\test.bat", vbNormalFocus
End Sub
最簡單的做法就是先把DOCUMENT.WRITELN(''),用空白代替,Unicode轉碼後再轉成html物件就好了
雖然會讓一些語法出問題,但排版、表格、文字,都可以正常使用
這樣就可以簡單用vba取出正確的資料
'(這裡只貼出台新,另外5家很普通,請自行到附件中的副程式裡參考)
Sub 台新()
Dim Xmlhttp As Object, Html As Object, Clipboard As Object, Url As String, Url_a As String, ttt As Double
Set Clipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Set Xmlhttp = CreateObject("Msxml2.XMLHTTP")
Set Html = CreateObject("HtmlFile")
ttt = Timer
Url = "https://www.taishinbank.com.tw/eService/transactionrate/transactionrateExport.jsp?no=3"
Url_a = "https://www.taishinbank.com.tw/TSB/customer-service-center/lookup/realtime/"
With Xmlhttp
.Open "GET", Url, False
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "Referer", Url_a
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
Html.body.innerhtml = Replace(Unicode_to_cht(Replace(Replace(.responsetext, "[removed]ln('", ""), "');", "")), "\", "")
Debug.Print Replace("台新(" & Split(Split(Html.body.innertext, "更新時間 : ")(1), "幣別")(0) & ")", vbCrLf, "")
Debug.Print Replace(Sheets("工作表1").Range("c2").Value, Year(Now()), Year(Now()) - 1911)
End With
With Sheets("台新")
.Select
.Cells.Clear
.Cells(1, 1).Select
Clipboard.SetText Html.all.tags("table")(3).innerhtml
Clipboard.PutInClipboard
.PasteSpecial NoHTMLFormatting:=True
.Cells(20, 1).Select
Clipboard.SetText Html.all.tags("table")(5).innerhtml
Clipboard.PutInClipboard
.PasteSpecial NoHTMLFormatting:=True
End With
With Sheets("台新")
For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If InStr(.Cells(i, 1).Value, "黃金") = 0 Then .Cells(i, 1).Value = Right(.Cells(i, 1).Value, 3)
If .Cells(i, 2) = "-" Then .Cells(i, 2) = ""
If .Cells(i, 3) = "-" Then .Cells(i, 3) = ""
Next i
.Columns.AutoFit
.Cells(1, 1).Select
End With
Debug.Print "台新:" & Round(Timer - ttt, 3) & "秒"
Set Xmlhttp = Nothing
Set Clipboard = Nothing
Set Html = Nothing
End Sub
[點擊下載]































































































