关于局域网数据库的更新问题

roych

这里给一段在线升级的代码：
建立模块1：

1. Public Function GetVersion(FileName As String, strPWS As String) As String
   
2.     Dim rst As ADODB.Recordset
   
3.     strConn = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & FileName & ";jet oledb:database password='" & strPWS & "'"
   
4.     strSQL = "select * from tblversion"
   
5.     Set rst = New ADODB.Recordset
   
6.     rst.CursorLocation = adUseClient
   
7.     rst.Open strSQL, strConn
   
8.     rst.MoveFirst
   
9.     GetVersion = rst!Version
   
10.     rst.Close
    
11.     Set rst = Nothing
    
12. End Function

复制代码

主控界面升级代码：

1. Dim appAccess As Access.Application
   
2. Dim db As Database
   
3. Public Sub OpenDB()
   
4.     Dim strDB As String
   
5.     strDB = CurrentProject.Path & "\EmpInfSys.mdb"
   
6.     Set appAccess = CreateObject("Access.Application")
   
7.     Set db = appAccess.DBEngine.OpenDatabase(strDB, False, False, ";PWD=")
   
8.     appAccess.OpenCurrentDatabase strDB
   
9.     If Val(SysCmd(acSysCmdAccessVer)) = 9 Then
   
10.         appAccess.Visible = True
    
11.     End If
    
12.     DoCmd.Quit
    
13. End Sub
    
14. 
    
15. 
    
16. Private Sub Form_Load()
    
17.     DoCmd.RunCommand acCmdAppMinimize
    
18.    
    
19.   Dim strFileName As String
    
20.   strFileName = "\\szas3k01\CNCoats\SCTTC\Special Folder\EmplnfSys\network\networkTest.mdb"
    
21.   If Dir(strFileName, vbDirectory) = "" Then
    
22.   MsgBox "系统检测到网络不通,不能启动系统.可能是本机网络不通或是管理员在维护后台数据,请稍后再试或联系东东跟进!", vbOKOnly, "辅助系统络网检测提示"
    
23.   DoCmd.Quit
    
24.   End If
    
25.    
    
26.    
    
27.    
    
28.     Dim SourceFile As String
    
29.     Dim SourceFile1 As String
    
30.     Dim DestinationFile As String
    
31.     Dim DestinationFile1 As String
    
32.     Dim localVision As String
    
33.     Dim serverVision As String
    
34. '后台版本和前台版本文件
    
35.     SourceFile = "\\szas3k01\CNCoats\SCTTC\Special Folder\EmplnfSys\NewVersion\EmpInfSys\Version.mdb"
    
36.     DestinationFile = CurrentProject.Path + "\Version.mdb"
    
37.     '后台数据库和前台数据库文件
    
38.     SourceFile1 = "\\szas3k01\CNCoats\SCTTC\Special Folder\EmplnfSys\NewVersion\EmpInfSys\后台数据库.mdb"
    
39.     DestinationFile1 = CurrentProject.Path + "\后台数据库.mdb"
    
40.     '检测路径（修改路径后未登录的用户将因此而无法登录）。
    
41.     If Dir(SourceFile) = "" Then
    
42.         MsgBox SourceFile & vbCrLf & "网路不通或文件不存在!", vbCritical, "提示"
    
43.         Exit Sub
    
44.     End If
    
45.     localVision = GetVersion(DestinationFile, "")
    
46.     serverVision = GetVersion(SourceFile, "")
    
47.     If localVision = serverVision Then
    
48.         OpenDB
    
49.     Else
    
50.         MsgBox "检测有新版本系统发布，现在开始在线升级系统! 请等候提示......", vbInformation, "提示"
    
51.         FileCopy SourceFile, DestinationFile
    
52.         FileCopy SourceFile1, DestinationFile1
    
53.         MsgBox "版本升级结束,欢迎登陆系统, 感谢关注和支持罗伊软件工作室作品!", vbInformation, "提示"
    
54.         OpenDB
    
55.     End If
    
56. End Sub
    
57. 
    
58. Private Sub Form_Open(Cancel As Integer)
    
59. DoCmd.RunCommand acCmdAppMinimize
    
60. End Sub

复制代码

请把必要的地址改为相应的数据。