麻烦各位老师帮忙解决一下 VBA获取网络时间更新系统时间的问题

20111107

下面是一段VBA获取网络时间并更新系统时间的VBA，但是一但断网就会报错，想请各位老师帮下手，修改一下，使其在联网状态下自动获取，断网时则获取系统内部的时间，谢谢！
Dim objXML As Object
    Dim strTemp As String
    Dim lStart As Long
    Dim lEnd As Long
    Dim DtWeb As Date
    Dim arr
    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, ",")
    网络时间 = CDate(arr(1) & arr(2))
   
    Date = CDate(arr(1))
   
    MsgBox CDate(arr(1))
   
    Range("a1") = VBA.Date
   
    If Date = "" Then
    Range("a1") = CurrentDate
   
    End If
    红色的那行，就是断网时报错的地方

liucqa

用on error goto处理

20111107

老师，能详细点吗？怎么处理？我是个菜鸟，不太懂，不好意思

20111107

20111107 发表于 2011-11-9 17:42
老师，能详细点吗？怎么处理？我是个菜鸟，不太懂，不好意思

上旋下弦月老师，能帮我修正一下传上来吗？万分感谢！

20111107

谢谢几位，已经搞定了，传上代码，给有需要的人分享下,当读取不到网络时间时，用系统时间代替
on error goto c
Dim objXML As Object
    Dim strTemp As String
    Dim lStart As Long
    Dim lEnd As Long
    Dim DtWeb As Date
    Dim arr
    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, ",")
    网络时间 = CDate(arr(1) & arr(2))
   
    Date = CDate(arr(1))
   
    MsgBox CDate(arr(1))
   
    Range("a1") = VBA.Date
   c:
    Range("a1") = CurrentDate
   

lotteryman

很不错。我也需要这个。

sunny_8848

即使错误， Range("a1") 都没有值？

maditate

err=empty
On Error Resume Next  错误处理器
objXML.sEnd ""
if err<> empty then
'  此处写本地时间语句
end if
on error goto 0

75109017@qq.com

对于以下代码中:
   objXML.Open "Get", "http://www.timeanddate.com/worldclock/city.html?n=33&Refresh=" & Rnd, False

作者是如何知道查北京时间需要输入下列文本的?
"?n=33&Refresh="

另外,我有一个问题, 我想访问这个网站:
http://www.cffex.com.cn/fzjy/ccpm/
需要在"产品"这个地方输入"IF", 而在"日期"框中,输入操作想要的时间, 例如,选择 "2014/4/30",  那么这个程序如何编写呢?  谢谢!

计算机微课堂

sunny_8848 发表于 2012-5-29 19:01
即使错误， Range("a1") 都没有值？

即使错误， Range("a1") 也根本没有数据显示