Question

我发现此代码将自动更新数据库的前端。我在为我实际工作时遇到了问题。

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

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

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

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程序执行以下代码：

Code:
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驱动器上的正确位置，然后启动程序并自行关闭。

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

我遵循了所有指示，当我运行它时，会弹出一个.laccdb。谁能说明为什么会这样？

这是我输入的内容（在两个单独的模块中）选项比较数据库

DoCmd.ShowToolbar "Ribbon", acToolbarNo

'Copy the new version to the C drive
Dim SourceFile, DestinationFile As String
SourceFile = "C:\Users\Tyrone\Desktop\MasterDatabase.accdb"   'Where to get  the fresh copy
DestinationFile = "C:\Users\Tyrone\Desktop\copy.accdb"   '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:\Users\Tyrone\Desktop\copy.accdb")
accapp.Visible = True
End Function



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

好的，既然你问了，这就是我的设置。主开发前端文件仅位于我（作为开发人员/管理员）具有权限的文件夹中。新版本将复制到名为Install的文件夹中，供用户从中下载。登录表单绑定到具有单个记录的表更新，而文本框绑定到版本字段。我在表单上使用标签作为版本号，以便与字段数据进行比较。

Version
Ver 9.8.0

代码（由于IT计算机更新不允许以编程方式复制文件而不再起作用）使用Windows Shell打开数据库：

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
    'don't forget to edit the VersionNumber label before copying frontend to Install folder 
    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

Answer 2

该锁定文件在数据库打开时出现，而在数据库关闭时消失。这与复制操作无关。为了确保该副本正常工作，请在其中放置一个具有相同名称的其他文件，然后观察“更新”。

自动更新器问题不能使用实用程序

2 个答案: