Excel–VBA获取网络时间

keywords：vba,vb,网络时间
有些时候需要取得网络时间，用于时间校验等用途 以前查到过的一段获取时间代码挺好用 它同时还能判断网络是否连接 代码如下

'****VBA网抓********excle880.com*************************************************************
'*功能： 获取网络时间
'*示例： MsgBox E8_WebTime
'****收集整理：百度不到去谷歌 QQ80871835  *******************************************************
Public Function E8_WebTime()
    Dim obj, OBJStatus, url, GetText, i
    Dim Retrieval
    url = "http://www.163.com"
    E8_WebTime = ""
    '判断网络是否连接
    If url <> "" Then
        Set Retrieval = GetObject("winmgmts:\\.\root\cimv2")
        Set obj = Retrieval.ExecQuery("Select * From Win32_PingStatus Where Address = '" & Mid(url, 8) & "'")
        For Each OBJStatus In obj
            If IsNull(OBJStatus.StatusCode) Or OBJStatus.StatusCode <> 0 Then
                MsgBox "网络未连接！"
                Exit Function
            Else
                Exit For    '已连接则继续
            End If
        Next
    End If

    '通过下载网页头信息获取网络时间
    Set Retrieval = CreateObject("WinHttp.WinHttpRequest.5.1")
    With Retrieval
        .Open "HEAD", url, False, "", ""
        .setRequestHeader "If-Modified-Since", "0"
        .setRequestHeader "Cache-Control", "no-cache"
        .setRequestHeader "Connection", "close"
        .Send
        If .Readystate <> 4 Then Exit Function
        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)
            E8_WebTime = CDate(GetText) + #8:00:00 AM#
        End If
    End With
    Set Retrieval = Nothing
    Set OBJStatus = Nothing
    Set obj = Nothing
End Function

Public Sub test() '测试
    MsgBox E8_WebTime
End Sub

你们要的文件下载

VBA获取网络时间.xls

http://pan.baidu.com/s/1ge54oQR

更多excel技术分享 请访问 http://excle880.com