刚学的，网抓北京时间

Public Sub 北京时间()
Dim xmlhttp As Object
Dim 时间
Set xmlhttp = CreateObject("msxml2.xmlhttp")
xmlhttp.Open "get", "http://time.tianqi.com/", False
xmlhttp.send
Do While xmlhttp.readystate <> 4
DoEvents
Loop
Dim StrResponse
StrResponse = StrConv(xmlhttp.responsebody, vbUnicode)
With CreateObject("VBScript.RegExp")
.Global = False
.Pattern = "[0-9]{2}\s[A-Z][a-z][a-z]\s[0-9]{4}\s[0-9]{2}.[0-9]{2}.[0-9]{2}"
If .test(StrResponse) Then
时间 = .Execute(StrResponse)(0)
Else
时间 = ""
End If
Cells(1, 1) = 时间
End With
End Sub