话题

Access通过Microsoft.XMLHTTP获取软件最新版本号并实现软件有新版本需要更新的提醒

（最新版本号放在网站指定页面）

Access通用开发平台有一个检查平台最新版本与平台当前的版本对比，如果版本不一致，就提示用户有新版本，请更新

这个函数的源码现在分享给大家，大家可用在自己的Access数据库中。

这个函数的原理，就是在服务器的指定目录下放置一个 你的软件最新的版本号的文本文件，里面只有一个内容，版本号，如：1.0.0.1

如我将我的Access软件 的最新版本号放在网站上 这个路径：

网页链接

然后通过

Microsoft.XMLHTTP, 使用get 方法 来获取这个文本文件里的版本号的值，并返回给函数

这个函数调用非常方便。但需要注意

1.如果使用的电脑网络 连接不畅或网络 比较慢，或无法访问外网，函数会执行一段时间，如果网络 很慢的话，可能会花去比较长的时间

2.所以最好是在执行这个函数前再做一个ping的函数，判断网络 是否通。不通的话，就跳过这个版本判断 。网络 通的话，则判断

获取Access软件系统最新版本的通用函数的源码如下：

Public Function gf_CheckNewVer() As String
'检测新版本, 如果与本地版本不符，则提醒用户 有新版本
’Access中国通用开发平台 检查 最新版本的函数    
    On Error GoTo Err_Handler
  
    Dim lngStartTime As Long
    Dim lngTry As Long
    
    Dim h As Object
    Dim strCurrentVer  As String
    Dim strNewVer As String
    Dim strIniFile As String
 
    '有时连到下一页 提示出错 ，如果出错，就代码再尝试一次，2次出错且超时时间大于20秒就返回
    lngStartTime = Timer
      
NxtTry:
    On Error GoTo Err_Handler
 
    gf_CheckNewVer = ''
    Set h = CreateObject('Microsoft.XMLHTTP')
      
    h.Open 'GET', '网页链接
    h.SetRequestHeader 'If-Modified-Since', '0' '禁止缓存 
    h.Send     
    If h.Status = 200 Then  'h.readyState = 4 '这个有时也不准
        strNewVer = StrConv(h.responseBody, vbUnicode)
         
        Set h = Nothing
    Else
        Set h = Nothing
    End If
    Dim Customer As String
    Dim strCustCode As String
    Dim lngCustId As Long
    
 
    gf_CheckNewVer = strNewVer
    
 
    strCurrentVer = gstrVersion
 
Exit Function
Err_Handler:
    gf_CheckNewVer = ''
    Select Case Err.Number
    Case 5415
        lngTry = lngTry + 1 
        If lngTry < 2 And (Timer - lngStartTime) < 30 Then 
           GoTo NxtTry 
        End If 
    End Select End Function

转载自Office中国论坛

如想更快的系统地学习Access数据库，请点右上角 关注 部落

点击加入群：access学习群  与更多Access大牛交流

如果您觉得这篇技巧真的有用，请关注我们。更重要手机转发分享一下！

如喜欢此技巧，手机右上角点开，分享到QQ空间，方便自己以后看