使用自动更新程序时遇到问题

Question

我是访问编码的新手，我遇到了一种远程更新数据库的简单方法。附件是我的数据库的指示和精简版本。谁能告诉我我做错了什么？提前致谢！！

这是一个很棒的模块，但是我想让人们知道你可以在不使用VBA的情况下进行版本检查，只需要一个运行VBA的Updater应用程序来删除本地副本并从服务器上下载新版本。

我在服务器的后端使用一个名为AppConstants的表，它有两列：ConstantTitle和ConstantValue。其中一行将ConstantTitle设置为“AppVersion”，将ConstantValue设置为版本号。

然后我在名为VersionNo的主窗体上将可见性设置为False的字段设置为False，并将此字段的值设置为=“VersionNumber”（其中VersionNumber是实际版本号，例如=“1.25”）。在Main Form的OnLoad事件中，我有一个在IF命令中运行DLookup的宏：

 if DLookUp("[ConstantValue]", "tblAdmin", "[ConstantTitle] ='AppVersion'")<>[Forms]![frmMain]![VersionNo] Then RunCode OpenUpdater()
 Quit Access
 End If

The code for OpenUpdater: 
Code:
Function OpenUpdater()  'This sets the name of the code to call later
Dim accapp As Access.Application
Set accapp = New Access.Application
accapp.OpenCurrentDatabase ("C:\$Data\MyUpdater.accde")  'Starts up this file
accapp.Visible = True
End Function 

它正在做什么：宏检查服务器上表中VersionNumber的值。当我在服务器上更新应用程序副本时，我在此处设置了新的版本号，并将我的应用程序副本的VersionNo字段设置为相同的数字。当您运行旧版本时，您的应用程序会看到版本号不匹配，然后执行宏的“然后”命令：它运行OpenUpdater代码并关闭自己。

OpenUpdater代码只是启动MyUpdater.accde程序，该程序默认安装在用户的PC上以及应用程序本身。 OpenUpdater程序执行以下代码：DoCmd.ShowToolbar“Ribbon”，acToolbarNo

'Copy the new version to the C drive
 Dim SourceFile, DestinationFile As String
 SourceFile = "Z:\Server\MyProgram.accde"   'Where to get the fresh copy
 DestinationFile = "C:\$Data\MyProgram.accde"   'Where to put it
 With CreateObject("Scripting.FileSystemObject")
 .copyfile SourceFile, DestinationFile, True    'This line does the acual  copy and paste
 End With

 'Reopen MyProgram
 Dim accapp As Access.Application
 Set accapp = New Access.Application
 accapp.OpenCurrentDatabase ("C:\$Data\MyProgram.accde")
 accapp.Visible = True
 End Function 

此函数在MyUpdater中的宏中调用，此宏中RunCode之后的命令是QuitAccess，它关闭了Updater。

因此，当您打开主窗体时，我的主程序会检查服务器上的版本号。如果它们不同，主程序将启动更新程序，然后自行关闭。更新程序将新版本从服务器上复制并粘贴到C驱动器上的正确位置，然后启动程序并关闭自身。

从最终用户的角度来看，程序启动，立即退出，然后在大约一秒钟后再次启动，现在它已更新。它很棒。

我的问题是当我打开复制数据库时，更新没有运行但是当我进入myupdater数据库并手动运行宏时它会运行。这是宏

If DLookUp("[ConstantValue]","AppConstants","[ConstantTitle]='AppVersion'")<>[Forms]![NavMain]![VersionNo]
Then RunCode FunctionName OpenUpdater() 
Quit   Access

这是功能

Function OpenUpdater()  'This sets the name of the code to call later
Dim accapp As Access.Application
Set accapp = New Access.Application
accapp.OpenCurrentDatabase  ("C:\Users\Tyrone\Desktop\MyUpdater.accde")  'Starts up this file
accapp.Visible = True
End Function

Answer 1

发布的代码与我使用的类似。我也使用了脚本方法，但我喜欢在Access中使用所有内容而不必在每台用户计算机上安装脚本文件。但是，我没有使用宏，只有VBA。 VBA位于默认打开的登录表单后面。表单绑定到Updates表，因此DLookup（）不用于版本检查。 gstrBasePath是在通用模块中声明的全局常量。这使用Windows Shell，因此有必要设置对Microsoft Shell Controls和Automation库的引用。不幸的是，IT更新了计算机的额外限制，根本不允许程序化文件副本（最初仅限于C：\ root位置），这对我来说不再适用。

Private Sub Form_Load()

'Check for updates to the program on start up - if values don't match then there is a later version
If Me.tbxVersion <> Me.lblVersion.Caption Then
    'because administrator opens the master development copy, only run this for non-administrator users
    If DLookup("Permissions", "Users", "UserNetworkID='" & Environ("UserName") & "'") <> "admin" Then
        'copy Access file
        CreateObject("Scripting.FileSystemObject").CopyFile _
            gstrBasePath & "Program\Install\MaterialsDatabase.accdb", "c:\", True
        'allow enough time for file to completely copy before opening
        Dim Start As Double
        Start = Timer
        While Timer < Start + 3
            DoEvents
        Wend
        'load new version - SysCmd function gets the Access executable file path
        'Shell function requires literal quote marks in the target filename string argument, apostrophe delimiters fail, hence the quadrupled quote marks
        Shell SysCmd(acSysCmdAccessDir) & "MSAccess.exe " & """" & CurrentProject.FullName & """", vbNormalFocus
        'close current file
        DoCmd.Quit
    End If
Else
    'tbxVersion available only to administrator to update version number in Updates table
    Me.tbxVersion.Visible = False
    Call UserLogin
End If

End Sub

Private Sub tbxUser_AfterUpdate()
If Me.tbxUser Like "[A-z][A-z][A-z]" Or Me.tbxUser Like "[A-z][A-z]" Then
    CurrentDb.Execute "INSERT INTO Users(UserNetworkID, UserInitials, Permissions) VALUES('" & VBA.Environ("UserName") & "', '" & UCase(Me.tbxUser) & "', 'staff')"
    Call UserLogin
Else
    MsgBox "Not an appropriate entry.", vbApplicationModal, "EntryError"
End If
End Sub

Private Sub UserLogin()
Me.tbxUser = DLookup("UserInitials", "Users", "UserNetworkID='" & Environ("UserName") & "'")
If Not IsNull(Me.tbxUser) Then
    CurrentDb.Execute "UPDATE Users SET ComputerName='" & VBA.Environ("ComputerName") & "' WHERE UserInitials='" & Me.tbxUser & "'"
    DoCmd.OpenForm "Menu", acNormal, , "UserInitials='" & Me.tbxUser & "'", , acWindowNormal
    DoCmd.Close acForm, Me.Name, acSaveNo
End If
End Sub