利用VBA从网络获取时间来校准计算机时间

可以利用Microsoft.XMLHTTP来读取网页内容，请参考下列代码。

Sub 利用网络时间校对当前计算机时间() Dim objXML As Object Dim strTemp As String Dim lStart As Long Dim lEnd As Long Dim DtWeb As Date '建立XMLHTTP对象。并获取http://www.timeanddate.com/worldclock/city.html?n=33的网页Text '&Refresh=" & Rnd 是为了避免直接从IE缓存中读取 Set objXML = CreateObject("Microsoft.XMLHTTP") Randomize '初始化随机数，避免IE缓存重复 objXML.Open "Get", "http://www.timeanddate.com/worldclock/city.html?n=33&Refresh=" & Rnd, False objXML.sEnd "" strTemp = objXML.responseText Set objXML = Nothing '对网页进行处理，找出当前日期和时间 lStart = InStr(1, strTemp, "Current Time", vbTextCompare) lEnd = InStr(lStart, strTemp, "</strong>", vbTextCompare) strTemp = Mid(strTemp, lStart, lEnd - lStart) strTemp = Replace(strTemp, "Current Time</th><td><strong id=ct class=big>", "") arr = Split(strTemp, ",") DtWeb = CDate(arr(1) & arr(2)) '设置当前日期和时间 Date = DtWeb Time = DtWeb MsgBox "日期和时间已经校对成功！" & vbCrLf & "当前日期和时间为：" & DtWeb End Sub

时间处理除上述方法外，还可以采取以下方法

strTemp = ObjXML.getResponseHeader("Date") ArrTmp = Split(DateTxt, " ") lBd = LBound(ArrTmp) DtWeb = Format(ArrTmp(lBd + 1) & "-" & ArrTmp(lBd + 2) & "-" & ArrTmp(lBd + 3), "yy-m-d") + CDate(ArrTmp(lBd + 4)) + "8:00:00"

利用网络获取时间的意义在于制作具有有效期验证的VBA程序，避免用户修改计算机时间作弊。

上述获取网页内容的方法还可以用于网页的分析以及实时更新Excel表格内容。

 

 

参考附件：

如何利用VBA从网络获取时间来校准计算机时间？ http://www.exceltip.net/thread-7658-1-1-11314.html