|
这里给一段在线升级的代码:
建立模块1:- Public Function GetVersion(FileName As String, strPWS As String) As String
- Dim rst As ADODB.Recordset
- strConn = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & FileName & ";jet oledb:database password='" & strPWS & "'"
- strSQL = "select * from tblversion"
- Set rst = New ADODB.Recordset
- rst.CursorLocation = adUseClient
- rst.Open strSQL, strConn
- rst.MoveFirst
- GetVersion = rst!Version
- rst.Close
- Set rst = Nothing
- End Function
复制代码 主控界面升级代码:- Dim appAccess As Access.Application
- Dim db As Database
- Public Sub OpenDB()
- Dim strDB As String
- strDB = CurrentProject.Path & "\EmpInfSys.mdb"
- Set appAccess = CreateObject("Access.Application")
- Set db = appAccess.DBEngine.OpenDatabase(strDB, False, False, ";PWD=")
- appAccess.OpenCurrentDatabase strDB
- If Val(SysCmd(acSysCmdAccessVer)) = 9 Then
- appAccess.Visible = True
- End If
- DoCmd.Quit
- End Sub
- Private Sub Form_Load()
- DoCmd.RunCommand acCmdAppMinimize
-
- Dim strFileName As String
- strFileName = "\\szas3k01\CNCoats\SCTTC\Special Folder\EmplnfSys\network\networkTest.mdb"
- If Dir(strFileName, vbDirectory) = "" Then
- MsgBox "系统检测到网络不通,不能启动系统.可能是本机网络不通或是管理员在维护后台数据,请稍后再试或联系东东跟进!", vbOKOnly, "辅助系统络网检测提示"
- DoCmd.Quit
- End If
-
-
-
- Dim SourceFile As String
- Dim SourceFile1 As String
- Dim DestinationFile As String
- Dim DestinationFile1 As String
- Dim localVision As String
- Dim serverVision As String
- '后台版本和前台版本文件
- SourceFile = "\\szas3k01\CNCoats\SCTTC\Special Folder\EmplnfSys\NewVersion\EmpInfSys\Version.mdb"
- DestinationFile = CurrentProject.Path + "\Version.mdb"
- '后台数据库和前台数据库文件
- SourceFile1 = "\\szas3k01\CNCoats\SCTTC\Special Folder\EmplnfSys\NewVersion\EmpInfSys\后台数据库.mdb"
- DestinationFile1 = CurrentProject.Path + "\后台数据库.mdb"
- '检测路径(修改路径后未登录的用户将因此而无法登录)。
- If Dir(SourceFile) = "" Then
- MsgBox SourceFile & vbCrLf & "网路不通或文件不存在!", vbCritical, "提示"
- Exit Sub
- End If
- localVision = GetVersion(DestinationFile, "")
- serverVision = GetVersion(SourceFile, "")
- If localVision = serverVision Then
- OpenDB
- Else
- MsgBox "检测有新版本系统发布,现在开始在线升级系统! 请等候提示......", vbInformation, "提示"
- FileCopy SourceFile, DestinationFile
- FileCopy SourceFile1, DestinationFile1
- MsgBox "版本升级结束,欢迎登陆系统, 感谢关注和支持罗伊软件工作室作品!", vbInformation, "提示"
- OpenDB
- End If
- End Sub
- Private Sub Form_Open(Cancel As Integer)
- DoCmd.RunCommand acCmdAppMinimize
- End Sub
复制代码 请把必要的地址改为相应的数据。 |
|