一键部署发布和更新 Microsoft Access 数据库应用程序

2022-04-06 14:59:55

在普通 Windows 环境中部署 Microsoft Access 应用程序并不困难，但需要几个步骤。此处提供的方法和脚本将 - 从字面上看 - 将流程变成用户的一键式流程，即使在 Citrix 环境中也是如此。

一、目标

部署 Microsoft Access 应用程序的方法有很多种。其中许多需要用户执行几个步骤，而有些则不考虑更新。

然而，这里的方法只需要用户一键安装和运行应用程序。此外，它将允许根据开发人员的意愿对应用程序进行全自动更新——只需一个新版本的简单文件副本即可，并且可以在部分或所有用户启动应用程序时完成。

用户只需要直接访问快捷方式文件。这可以位于网络文件夹中、从 URL 检索或附加电子邮件。次双击时，它将安装应用程序和桌面快捷方式。下一次，将从分发文件夹中提取应用程序的新副本 - 更新当前副本，或替换可能已损坏或臃肿的前端文件。

二、它是如何完成的

实现起来非常简单：

双击快捷方式打开脚本
脚本运行并处理其余部分：

将应用程序文件复制到本地文件夹
设置注册表项以信任此本地文件夹
将快捷方式复制到用户的桌面文件夹
启动应用程序

当用户关闭应用程序时，快捷方式出现在桌面上。要再次启动应用程序，用户将双击快捷方式，并重复上述过程。

分发文件夹和文件的基本结构如下：

如图所示，在主分发文件夹中只有快捷方式和一个子文件夹。

子文件夹（此处：Files）仅包含三个文件：

应用程序文件 - accdb、acde 或 accdr 类型
快捷方式的图标文件（可选，但推荐）
脚本

扩展结构可以包括两组或多组快捷方式和子文件夹，例如：

分销\生产
分发\测试

分发给用户的快捷方式与上图中顶部列出的快捷方式相同。请记住，它是脚本文件的快捷方式，而不是 Microsoft Access 或应用程序文件的快捷方式。

要更新应用程序，只需更新子文件夹中的应用程序文件。当用户注销并稍后重新启动应用程序时，应用程序文件将被复制到用户的本地文件夹，覆盖之前的副本，然后启动新版本。这再简单不过了。

当然，也可以进行降级；将应用程序文件替换为以前的版本，仅此而已。

三、要求

要按照描述部署和运行您的 Access 应用程序，您将需要：

将Microsoft Access安装为完整安装或运行时
已授予用户完全权限的本地文件夹路径
为注册表中的 受信任位置设置一些安全设置
用于复制应用程序文件并创建桌面快捷方式的脚本
调用脚本的快捷方式

Microsoft Access runtime（运行时）

如何安装以及选择哪个版本对于流程和脚本并不重要。它是为 Microsoft Access 2010 创建的，应该适用于 2013 和 2019，并且已经过 2016/365 测试。

如何安装和配置其中任何一个 - 作为完整安装或作为运行时 - 超出了本文的范围。

本地文件夹

使用的佳文件夹路径是LocalAppData。 要查看它的位置，请在 Windows 资源管理器中键入%localappdata% ：

并按Enter。它将解析为：

C:\Users\NameOfUserProfile\AppData\Local

在这里，您通常会创建一个子文件夹和一个子文件夹，例如：

\组织名称\应用程序名称

托管应用程序文件的本地副本。

使用上面列出的分发文件夹和文件示例名称，生成的本地结构将 - 除了桌面文件夹中的快捷方式文件 - 仅包含一个文件：

注册表设置

这些是特定于每个版本的 Microsoft Access，因此请注意。

脚本中的一行控制了这一点。默认情况下，它设置为适合Microsoft Access 2016和Microsoft Access 365：

' Environment specific constants.
    '
    ' Expected version of Microsoft Access - the returned value of property:
    '   ? Access.Application.Version
    Const AccessVersion = "16.0"

保存设置的注册表项（对于 16.0 版）将是：

HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Access\Security\

它将保存分配给上述本地文件夹的受信任位置的条目，并防止在启动应用程序时显示来自 Microsoft Access 的警告消息。

脚本

该脚本是用VBScript 编写的，看起来可能非常全面。但是，它并不复杂，并且内嵌注释解释了每一步。它执行的主要任务是：

验证/创建本地文件夹
将应用程序文件复制到本地文件夹和桌面的快捷方式
为 Microsoft Access 安全性编写注册表项
启动应用程序

完整清单是：

Option Explicit

' Launch script for a Microsoft Access application.
' Version 2.0.2
' 2019-01-15
' Cactus Data. Gustav Brock

' ---------------------------------------------------------------------------------
' This script file must be placed in a distribution folder, like:
'   F:\Distribution\AppName
'
' That folder must have subfolder(s) for the app type(s).
' - for one app type only, for example:
'	F:\Distribution\AppName\Files
' - for, say, three app *:
'	F:\Distribution\AppName\Operations
'	F:\Distribution\AppName\Test
'	F:\Distribution\AppName\Development
'
' Specify the next constants for a resulting install path of:
'	%LocalAppData%\OrgSubfolderName\AppSubfolderName\App*ubfolderName
' - for example resulting in:
'	C:\Users\UserProfileName\AppData\Local\Organisation\AppName\Operations
' ---------------------------------------------------------------------------------

' ---------------------------------------------------------------------------------
' Environment specific constants.
    '
    ' Expected version of Microsoft Access - the returned value of property:
    '   ? Access.Application.Version
    Const AccessVersion = "16.0"
' ---------------------------------------------------------------------------------

' ---------------------------------------------------------------------------------
' Application specific constants.
    '
    ' Source filename.
    Const AppBaseName = "DMadresser"
    ' Extension name. Uncomment ONE extension name only.
    'Const AppExtensionName = "accdb"
    'Const AppExtensionName = "accde"
    Const AppExtensionName = "accdr"
    ' Optional suffix.
    Const AppNoColourSuffix = "NC"
    
    ' Local install folder names. Will be (sub)subfolders of %LocalAppData%.
    Const OrgSubfolderName = "DM"
    Const AppSubfolderName = "DM Administration"
    
    ' Shortcut name(s). Uncomment ONE folder name ONLY:
    Const ShortcutBaseName = "DM Adresser"
    'Const ShortcutBaseName = "DM Adresser Test"
    
    ' Title of the application when running. For TaskKill in subfunction KillTask.
    Const AppWindowTitle = "DM ADRESSER"
' ---------------------------------------------------------------------------------

' ---------------------------------------------------------------------------------
' Installation specific constants.
    
    ' Distribution folder names. Uncomment ONE folder name ONLY:
    Const App*ubfolderName = "Files"
    'Const App*ubfolderName = "Development"
    'Const App*ubfolderName = "Operations"
    'Const App*ubfolderName = "Test"

    ' Indicate if the script is for the normal version (0) or a no-colour version (1):
    Const NoColour = 0

    ' Force a close of an open application even if blocked by a modal message box.
    Const ForceClose = True
' ---------------------------------------------------------------------------------


' ---------------------------------------------------------------------------------
' Script.

    ' Windows folder constants.
    Const DESKTOP = &H10
    Const LOCALAPPDATA = &H1C
    ' Extension of a shortcut.
    Const ShortcutExtensionName = "lnk"

    ' Objects.
    Dim FileSystemObject
    Dim AppShell
    Dim DesktopFolder
    Dim LocalAppDataFolder
    Dim LocalFolder
    Dim RemoteFolder

    ' Variables.
    Dim LocalFolderName
    Dim RemoteFolderName
    Dim DesktopFolderName
    Dim LocalAppDataFolderName
    Dim LocalAppDataOrgFolderName
    Dim LocalAppDataOrgAppFolderName
    Dim AppName
    Dim AppExtension
    Dim AppSuffix
    Dim ShortcutName
    Dim AppLocalPath
    Dim AppRemotePath
    Dim ShortcutExtension
    Dim ShortcutLocalPath
    Dim ShortcutRemotePath
    Dim RegPath
    Dim RegKey
    Dim RegValue
    Dim Value


    ' Create the Shell object and the File System Object.
    Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set AppShell = CreateObject("Shell.Application")

    ' Build distribution folder name.
    RemoteFolderName = FileSystemObject.GetParentFolderName(WScript.ScriptFullName)

    ' Build filenames.
    If NoColour = 1 Then
        AppSuffix = AppNoColourSuffix
    Else
        AppSuffix = ""
    End If
    AppExtension = "." & AppExtensionName
    AppName = AppBaseName & AppSuffix & AppExtension
    ShortcutExtension = "." & ShortcutExtensionName
    ShortcutName = ShortcutBaseName & AppSuffix & ShortcutExtension

    ' Enable in-line error handling.
    On Error Resume Next

    ' Find user's Desktop and AppData\Local folder.
    Set DesktopFolder = AppShell.Namespace(DESKTOP)
    DesktopFolderName = DesktopFolder.Self.Path
    Set LocalAppDataFolder = AppShell.Namespace(LOCALAPPDATA)
    LocalAppDataFolderName = LocalAppDataFolder.Self.Path

    ' Uncomment to debug.
    'WScript.Echo "Desktop: " & DesktopFolderName & vbCrLf & "LocalAppData: " & LocalAppDataFolderName

    ' Dynamic parameters.
    LocalAppDataOrgFolderName = FileSystemObject.BuildPath(LocalAppDataFolderName, OrgSubfolderName)
    LocalAppDataOrgAppFolderName = FileSystemObject.BuildPath(LocalAppDataOrgFolderName, AppSubfolderName)
    LocalFolderName = FileSystemObject.BuildPath(LocalAppDataOrgAppFolderName, App*ubfolderName)
    AppLocalPath = FileSystemObject.BuildPath(LocalFolderName, AppName)
    ShortcutLocalPath = FileSystemObject.BuildPath(DesktopFolderName, ShortcutName)

    ' Permanent parameters.
    AppRemotePath = FileSystemObject.BuildPath(RemoteFolderName, AppName)
    ShortcutRemotePath = FileSystemObject.BuildPath(FileSystemObject.BuildPath(RemoteFolderName, ".."), ShortcutName)

    ' Verify/create the local folders.
    If Not FileSystemObject.FolderExists(RemoteFolderName) Then
        Call ErrorHandler("No access to " & RemoteFolderName & ".")
    Else
        Set RemoteFolder = FileSystemObject.GetFolder(RemoteFolderName)
        ' If the local folder does not exist, create the folder.
        If Not FileSystemObject.FolderExists(LocalFolderName) Then
            If Not FileSystemObject.FolderExists(LocalAppDataOrgFolderName) Then
                Set LocalFolder = FileSystemObject.CreateFolder(LocalAppDataOrgFolderName)
                If Not Err.Number = vbEmpty Then
                    Call ErrorHandler("Folder " & LocalAppDataOrgFolderName & " could not be created.")
                End If
            End If
            If Not FileSystemObject.FolderExists(LocalAppDataOrgAppFolderName) Then
                Set LocalFolder = FileSystemObject.CreateFolder(LocalAppDataOrgAppFolderName)
                If Not Err.Number = vbEmpty Then
                    Call ErrorHandler("Folder " & LocalAppDataOrgAppFolderName & " could not be created.")
                End If
            End If
            If Not FileSystemObject.FolderExists(LocalFolderName) Then
                Set LocalFolder = FileSystemObject.CreateFolder(LocalFolderName)
                If Not Err.Number = vbEmpty Then
                    Call ErrorHandler("Folder " & LocalFolderName & " could not be created.")
                End If
            End If
        End If
        Set LocalFolder = FileSystemObject.GetFolder(LocalFolderName)
    End If

    ' Copy the distribution file to the local folder and the shortcut to the Desktop.
    If Not FileSystemObject.FileExists(AppRemotePath) Then
        Call ErrorHandler("The application file:" & vbCrLf & AppRemotePath & vbCrLf & "could not be found.")
    Else
        ' First, close a running application - using the setting of constant ForceClose.
        Call KillTask(AppWindowTitle)
        ' Wait while TaskKill is running to close the instance of the application.
        Call AwaitProcess("taskkill.exe")

        ' Copy app to local folder.
        If FileSystemObject.FileExists(AppLocalPath) Then
            FileSystemObject.DeleteFile(AppLocalPath)
            If Not Err.Number = 0 Then
                If IsProcess("MSACCESS.EXE") Then
                    ' The application may be blocked for closing by a modal message box.
                    MsgBox "Cannot update or reinstall the application while it is running.", vbCritical + vbOkOnly, AppWindowTitle
                    WScript.Quit        
                Else
                    Call ErrorHandler("The application file:" & vbCrLf & AppName & vbCrLf & "can not be refreshed/updated. It may be in use.")
                End If
            End If
        End If
        If FileSystemObject.FileExists(AppLocalPath) Then
            Call ErrorHandler("The local application file:" & vbCrLf & AppLocalPath & vbCrLf & "could not be replaced.")
        Else
            FileSystemObject.CopyFile AppRemotePath, AppLocalPath
            If Not Err.Number = vbEmpty Then
                Call ErrorHandler("Application could not be copied to " & LocalFolderName & ".")
            End If
        End If

        ' Uncomment to debug.
        'WScript.Echo "Shortcut remote: " & ShortcutRemotePath & vbCrLf & "Shortcut local: " & ShortcutLocalPath

        ' Copy shortcut.
        FileSystemObject.CopyFile ShortcutRemotePath, ShortcutLocalPath
        If Not Err.Number = vbEmpty Then
            Call ErrorHandler("Shortcut could not be copied to your Desktop.")
        End If
    End If

    ' Write Registry entries for Microsoft Access security.
    RegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & AccessVersion & "\Access\Security\"
    RegValue = "VBAWarnings"
    RegPath = RegKey & RegValue
    Value = 1
    Call WriteRegistry(RegPath, Value,"REG_DWORD")

    RegKey = RegKey & "Trusted Locations\LocationLocalAppData\"
    RegValue = "AllowSubfolders"
    RegPath = RegKey & RegValue
    Value = 1
    Call WriteRegistry(RegPath, Value, "REG_DWORD")

    RegValue = "Date"
    RegPath = RegKey & RegValue
    Value = Now
    Value = FormatDateTime(Value, vbShortDate) & " " & FormatDateTime(Value, vbShortTime)
    Call WriteRegistry(RegPath, Value, "REG_SZ")

    RegValue = "Description"
    RegPath = RegKey & RegValue
    Value = "Local AppData"
    Call WriteRegistry(RegPath, Value, "REG_SZ")

    RegValue = "Path"
    RegPath = RegKey & RegValue
    Value = LocalAppDataFolderName & "\"
    Call WriteRegistry(RegPath, Value, "REG_SZ")

    ' Launch the application.
    If FileSystemObject.FileExists(AppLocalPath) Then
        Call RunApp(AppLocalPath)
    Else
        Call ErrorHandler("The local application file:" & vbCrLf & AppLocalPath & vbCrLf & "could not be found.")
    End If

    Set RemoteFolder = Nothing
    Set LocalFolder = Nothing
    Set LocalAppDataFolder = Nothing
    Set DesktopFolder = Nothing
    Set AppShell = Nothing
    Set FileSystemObject = Nothing

    ' Exit.
    WScript.Quit

' Exit script.
' ---------------------------------------------------------------------------------


' ---------------------------------------------------------------------------------
' Supporting (sub)functions.

Sub RunApp(ByVal Filename)

    Const vbNormalFocus = 1
    Const WaitOnReturn = False

    Dim Shell
    Dim Command
    Dim WindowStyle

    ' Open as default foreground application.
    WindowStyle = vbNormalFocus

    Set Shell = CreateObject("WScript.Shell")
    Command = """" & Filename & """"
    Shell.Run Command, WindowStyle, WaitOnReturn
    
    Set Shell = Nothing

End Sub


Sub KillTask(ByVal WindowTitle)

    Const vbMinimizedNoFocus = 7
    Const WaitOnReturn = False
    Const ForcedCloseOn = "/F"
    Const ForcedCloseOff = ""

    Dim Shell
    Dim Command
    Dim WindowStyle
    Dim CloseStyle

    ' Run silently.
    WindowStyle = vbMinimizedNoFocus

    Set Shell = CreateObject("WScript.Shell")
    If ForceClose = True Then
        CloseStyle = ForcedCloseOn
    Else
        CloseStyle = ForcedCloseOff
    End If
    Command = "TaskKill.exe /FI ""WINDOWTITLE eq " & WindowTitle & """ " & CloseStyle
    Shell.Run Command, WindowStyle, WaitOnReturn

    Set Shell = Nothing

End Sub


Sub AwaitProcess(ByVal Process)

    Dim Service
    Dim Query
    Dim Processes
    Dim Count

    Set Service = GetObject("winmgmts:root\cimv2")
    Query = "select * from win32_process where name = '" & Process & "'"

    Do
        Set Processes = Service.Execquery(Query)
        Count = Processes.Count
        If Count > 0 Then
            WScript.Sleep 300
        End If
    Loop Until Count = 0

    Set Processes = Nothing
    Set Service = Nothing

End Sub

Function IsProcess(ByVal Process)

    Dim Service
    Dim Query
    Dim Processes
    Dim Result

    Set Service = GetObject("winmgmts:root\cimv2")
    Query = "select * from win32_process where name = '" & Process & "'"

    Set Processes = Service.Execquery(Query)
    If Processes.Count > 0 Then
        Result = True
    Else
        Result = False
    End If

    Set Processes = Nothing
    Set Service = Nothing

    IsProcess = Result

End Function


Sub WriteRegistry(ByVal RegPath, ByVal Value, ByVal RegType)
    ' RegType should be:
    '   "REG_SZ" for a string
    '   "REG_DWORD" for an integer
    '   "REG_BINARY" for a binary or boolean
    '   "REG_EXPAND_SZ" for an expandable string

    Dim Shell

    Set Shell = CreateObject("WScript.Shell")

    Call Shell.RegWrite(RegPath, Value, RegType)

    Set Shell = Nothing

End Sub


Sub ErrorHandler(Byval Message)

    Set RemoteFolder = Nothing
    Set LocalFolder = Nothing
    Set LocalAppDataFolder = Nothing
    Set DesktopFolder = Nothing
    Set AppShell = Nothing
    Set FileSystemObject = Nothing

    MsgBox Message, vbExclamation + vbOkOnly, ShortcutBaseName
    WScript.Quit

End Sub


' End script.
' ---------------------------------------------------------------------------------

特定环境的所有设置和脚本的行为都由脚本顶部的常量控制。它们都经过仔细的评论，因此应该很容易使其按照您的要求运行。

如果您希望修改脚本而不是简单地调整常量或提示符，我强烈建议您为此使用Visual Studio Code，因为它很好地强调了关键字以及控制缩进，从这段代码中可以看出：