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

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

[vb] view plaincopyprint?

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

[vb] view plaincopyprint?

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

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

[vb] view plaincopyprint?

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

[vb] view plaincopyprint?

1. strTemp = ObjXML.getResponseHeader('Date')  
2. ArrTmp = Split(DateTxt, ' ')  
3. lBd = LBound(ArrTmp)  
4. 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