试用期的代码，哪个大侠最完善一下

'先引用Microsoft XML, v6.0
Option Explicit

Private Sub Form_Load()
On Error GoTo GetDateErr

Dim myXmlHttp As XMLHTTP
Set myXmlHttp = New XMLHTTP

myXmlHttp.open "GET", "http://m.baidu.com", False
myXmlHttp.send
Dim BaiduNow As Date


 BaiduNow = DateFromHTTP(myXmlHttp.getResponseHeader("Date"))

 BaiduNow = DateAdd("h", 8, BaiduNow)

 

MsgBox BaiduNow
Exit Sub
GetDateErr:
MsgBox "获取网络时间错误, 请确认已连接到网络"

End





End Sub
Public Function DateFromHTTP(HTTPDate As String) As Date

Const GMTDiff = 0

Dim Swd As String, d As String, Sm As String, Y As String, h As String, m As String, s As String, g As String, Out As Date
HTTPDate = LCase$(HTTPDate)

If Mid$(HTTPDate, 27, 3) = "gmt" Then
Swd = Left$(HTTPDate, 3)
d = Mid$(HTTPDate, 6, 2)
Sm = Mid$(HTTPDate, 9, 3)

Y = Mid$(HTTPDate, 13, 4)
h = Mid$(HTTPDate, 18, 2)
m = Mid$(HTTPDate, 21, 2)
s = Mid$(HTTPDate, 24, 2)
'    on error resume Next
Out = DateSerial(Y, mFromSm(Sm), d) + TimeSerial(h, m, s) '+ GMTDiff

End If
DateFromHTTP = Out


End Function


Function mFromSm(Sm As String) As Integer

Dim Out As Integer
Select Case LCase$(Sm)

Case "jan": Out = 1: Case "feb": Out = 2: Case "mar": Out = 3: Case "apr": Out = 4

Case "may": Out = 5: Case "jun": Out = 6: Case "jul": Out = 7: Case "aug": Out = 8



 Case "sep": Out = 9: Case "oct": Out = 10: Case "nov": Out = 11: Case "dec": Out = 12

 


End Select
mFromSm = Out










End Function