VBA从人民银行网站获取5个币种的历史汇率信息

Sub 汇率()
Dim url As String, arr, v() As String, i As Long, n As Long, p As Long, html As String
url = "http://www.pbc.gov.cn/huobizhengce/huobizhengcegongju/huilvzhengce/renminbihuilvjiaoyishoupanjia.asp?page=@" & datestr(#1/1/2009#) & datestr(Date)
[a:f] = ""
    [a1:f1] = Array("日期", "美元", "欧元", "日元", "港元", "英镑")
    p = 1
With CreateObject("Microsoft.XMLHTTP")
Do
DoEvents
.Open "get", Replace(url, "@", p), False
.send
html = StrConv(.responsebody, vbUnicode, &H804)
v = Split(html, "<font color="""">")
ReDim arr(9, 5)
    For i = 0 To UBound(v) - 1
    arr(i \ 6, i Mod 6) = Split(v(i + 1), "<")(0)
    Next
n = [a65536].End(3).Row + 1
Application.Goto "R" & n & "c1"
Cells(n, 1).Resize(10, 6) = arr
If InStr(html, "<font color=white>下一页</font></a>") = 0 Then Exit Do
p = p + 1
Loop
End With
MsgBox "Ok"
End Sub

Function datestr(ByVal d As Date) As String
datestr = "&toyear=" & Year(d) & "&tomonth=" & Month(d) & "&today=" & Day(d)
End Function