vba获取服务器信息及日期,VBA如何提取网络服务器上的北京时间

向各位大侠请教：最近在网络中找到一段代码用于提取服务器时间信息。其中尝试从网络中捕获服务器的时间数据，并发现执行后发现获取的时间并非当前的北京时间和服务器本地时间。其中所取的数据来自http://www.163.com网站的时间字段，在我的单位内部网络环境中能够顺利执行。而从该网站获取的时间与当前的实际北京时间存在差异，请问能否帮我检查一下这段代码？非常感谢！

Private Sub 提取网络服务器北京时间()

Dim obj, OBJStatus, url, GetText, i

Dim Retrieval

url = "http://www.163.com"

'判断网络是否连接

If url <> "" Then

Set Retrieval = GetObject("winmgmts:\ .\root\cimv2")

Set变量obj等于执行Win32 PingStatus中的查询结果

For Each OBJStatus In obj

If IsNull(OBJStatus.StatusCode) Or OBJStatus.StatusCode <> 0 Then

Exit Sub

Else

Exit For '已连接则继续

End If

Next

End If

'通过下载网页头信息获取网络时间

Set Retrieval = CreateObject("Microsoft.XMLHTTP")

With Retrieval

.Open "Get", url, False, "", ""

.setRequestHeader "If-Modified-Since", "0"

.setRequestHeader "Cache-Control", "no-cache"

.setRequestHeader "Connection", "close"

.sEnd

If .Readystate <> 4 Then Exit Sub

GetText = .getAllResponseHeaders()

i = InStr(1, GetText, "date:", vbTextCompare)

If i > 0 Then '网页下载成功

i = InStr(i, GetText, ",", vbTextCompare)

GetText = Trim(Mid(GetText, i + 1))

i = InStr(1, GetText, " GMT", vbTextCompare)

GetText = Left(GetText, i - 1)

MsgBox "网络时间:" & GetText

End If

End With

Set Retrieval = Nothing

Set OBJStatus = Nothing

Set obj = Nothing

End Sub

2015-6-23 19:36 上传

点击文件名下载附件

12.87 KB, 下载次数: 32