[分享]Excel VBA 抓取台灣銀行匯率

剛剛看到有在問抓取台灣銀行匯率的資料
所以幫忙寫了一下程式碼



Sub test()

Dim t: t = Timer

[A9:G50].ClearContents

Dim myXML As Object
Set myXML = CreateObject("Microsoft.XMLHTTP")

Dim myHTML As Object
Set myHTML = CreateObject("HTMLFile")

ReDim myArr(1 To 30, 1 To 7)

With myXML
.Open "GET", "http://rate.bot.com.tw/xrt?Lang=zh-TW", False
.send

'Debug.Assert InStr(1, .responseText, "28.94") <> 0
myHTML.body[removed] = .responseText
Set myTable = myHTML.getElementsByTagName("table")(0)
Set myTrs = myTable.getElementsByTagName("tbody")(0).getElementsByTagName("tr")
i = 1
For Each myTr In myTrs
Set myTds = myTr.getElementsByTagName("td")
j = 1
For Each myTd In myTds
If InStr(1, myTd.innerText, ")") <> 0 Then
myArr(i, j) = Split(Split(myTd.innerText, ")")(1) & ")", Chr(10))(1)
Else
myArr(i, j) = myTd.innerText
End If
If j > 5 Then ActiveSheet.Hyperlinks.Add anchor:=Cells(i + 8, j), Address:="http://rate.bot.com.tw" & Split(myTd.getElementsByTagName("a")(0).getAttribute("href"), ":")(1)
j = j + 1
If j > 7 Then Exit For
Next
i = i + 1
Next

[A9].Resize(UBound(myArr, 1), UBound(myArr, 2)).Value = myArr

End With

Set myXML = Nothing

Debug.Print Format(Timer - t, "0.00秒")

End Sub



用此程式甚至可以將上面的連結一起抓下來
供大家參考
https://raymondchiendtrt.blogspot.tw/2018/05/excel-vba.html