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