Ms access 自动更新程序问题可以'；不要使用工具

我发现这段代码将自动更新数据库前端。我在为自己工作时遇到了一些问题

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

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

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

其作用：宏检查服务器上表中VersionNumber的值。当我在服务器上更新应用程序副本时，我在此处设置了一个新版本号，并将我的应用程序副本的VersionNo字段设置为相同的编号。当您运行旧版本时，您的应用程序会发现版本号不匹配，然后执行宏的“then”命令：运行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中的宏中调用，该宏中运行代码后面的命令是QuitAccess，它关闭更新程序

因此，当您打开主窗体时，我的主程序会检查服务器上的版本号。如果它们不同，主程序将启动更新程序，然后自行关闭。更新程序从服务器上复制新版本并将其粘贴到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

---

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

Version
Ver 9.8.0

代码（由于计算机更新不允许编程复制文件，因此不再工作）使用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

Private子表单_Load（）
'启动时检查程序的更新-如果值不匹配，则有更高版本
如果Me.tbxVersion Me.lblVersion.Caption，则
'由于管理员打开主开发副本，因此仅对非管理员用户运行此操作
如果DLookup（“权限”、“用户”、“用户网络ID=””和环境（“用户名”）和“”）为“管理员”，则
'复制访问文件
CreateObject（“Scripting.FileSystemObject”）.CopyFile_
gstrBasePath&“Program\Install\MaterialsDatabase.accdb”，“c:\”，True
'在打开文件之前，为文件完全复制留出足够的时间
双倍起跳
开始=计时器
当定时器<启动+3时
多芬特
温德
'加载新版本-SysCmd函数获取访问可执行文件路径
'Shell函数要求在目标文件名字符串参数中使用文字引号，撇号分隔符失败，因此使用四倍引号
Shell SysCmd（acSysCmdAccessDir）和“MSAccess.exe”和“&CurrentProject.FullName&”，vbNormalFocus
'关闭当前文件
医生，退出
如果结束
其他的
'tbxVersion仅对管理员可用，用于更新更新表中的版本号
'在将前端复制到安装文件夹之前，不要忘记编辑版本号标签
Me.tbxVersion.Visible=False
呼叫用户登录
如果结束
端接头
专用子tbxUser_AfterUpdate（）
如果Me.tbxUser喜欢“[A-z][A-z][A-z]”或者Me.tbxUser喜欢“[A-z][A-z]”，那么
CurrentDb.Execute“插入用户（UserNetworkID、UserInitials、Permissions）值（'”&VBA.Environ（“UserName”）&“，'”&UCase（Me.tbxUser）&“，”staff'）”
呼叫用户登录
其他的
MsgBox“不是适当的条目”，VBApplicationModel，“EntryError”
如果结束
端接头
私有子用户登录（）
Me.tbxUser=DLookup（“UserInitials”、“Users”、“UserNetworkID=””和Environ（“UserName”）&“”）
如果不为null（Me.tbxUser），则
CurrentDb.Execute“updateuserssetcomputername=”&VBA.Environ（“ComputerName”）&“WHERE UserInitials=”&Me.tbxUser&“”
DoCmd.OpenForm“Menu”，acNormal，“UserInitials=””&Me.tbxUser&“”，acWindowNormal
DoCmd.Close acForm，Me.Name，acSaveNo
如果结束
端接头

该锁定文件在数据库打开时显示，在数据库关闭时应消失。这与复制操作无关。为确保副本正常工作，请在其中放置一个同名的不同文件，并观看“更新”的发生。

我使用了类似的代码，但从未注意到laccdb“弹出”。你说的“弹出”到底是什么意思？代码运行了好几年，直到它更新了计算机，不再允许以编程方式复制文件。非常烦人。@June7我的笔记本电脑上会弹出一个副本数据库的锁定版本，而不是更新副本数据库以匹配母版。您是否碰巧有您正在使用的工具？我建议使用另一种工具，试试这个：laccdb文件是Access在打开accdb文件时创建的临时文件。它不应该“弹出”。我甚至不应该意识到。是的，我意识到了。这两个数据库都在我的桌面上，我看到锁文件在代码运行时出现和消失。我认为复制粘贴部分不起作用，因为

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