citrix应用程序虚拟化

思杰不灵活 (Citrix is inflexible)

This is notorious and for a reason. The environment provides tight security, so no steps altering it will be allowed except for a very good reason - and deploying your Access application  is not such one.

这是一个臭名昭著的原因。 该环境提供了严格的安全性，因此除非有充分的理由，否则不允许进行任何更改步骤的环境-部署Access应用程序并非如此。

Thus, you'll have to play by the rules. This means that you'll have to adapt to the security and user rights as is.

因此， 您必须遵守规则。 这意味着您必须原样适应安全性和用户权限。

Also, however skilled they are, Citrix system people tend to be specialists, and Microsoft Access is way outside their focus. This means that you can hardly count on any help even though your organisation pays big money for support.

而且，无论他们多么熟练，Citrix系统人员往往都是专家，Microsoft Access不在他们的关注范围之内。 这意味着即使您的组织付出了巨大的支持费用，您也几乎无法指望任何帮助。

To put is bluntly: You are on your own.

坦率地说： 你是一个人。

Please note: A revised version of the script has been published here January 2019:

请注意：该脚本的修订版已于2019年1月在这里发布：

Deploy and update a Microsoft Access application with one click

一键部署和更新Microsoft Access应用程序

Though the comments on  and considerations for Citrix mentioned above are still valid, the revised script has been optimised for the typical installation scenario using Windows 10 and Microsoft Office 365.

尽管上面提到的有关Citrix的注释和注意事项仍然有效，但已针对Windows 10和Microsoft Office 365的典型安装方案对修订后的脚本进行了优化。

你需要什么 (What you need)

To deploy and run your Access application you need:

要部署和运行Access应用程序，您需要：

• a folder path where the user has full rights用户具有完整权限的文件夹路径
• to set some security settings in the Registry在注册表中设置一些安全设置
• a script to copy your application file and create Desktop shortcut脚本来复制您的应用程序文件并创建桌面快捷方式

The best folder path to use is LocalAppData. To see where it lives, type %localappdata%  in Windows Explorer:

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

and press Enter. Here you will typically create a folder and a subfolder, like: \OrginisationName\ApplicationName, to host your accdb file.

然后按Enter。 在这里，您通常将创建一个文件夹和一个子文件夹 （例如：\ OrginisationName \ ApplicationName）来托管您的accdb文件。

The security settings in the Registry  will prevent the security warnings popping forward when the application is launched.

注册表中的安全设置将防止启动应用程序时突然弹出安全警告。

The script  carries out these tasks:

该脚本执行以下任务：

• creates subfolders in the user's LocalAppData  folder在用户的LocalAppData文件夹中创建子文件夹
• kills the application should it be running杀死正在运行的应用程序
• copies the current version of the application to the local folder将应用程序的当前版本复制到本地文件夹
• copies a second copy (launched by the first for background tasks)复制第二份副本（由第一份副本启动以执行后台任务）
• creates/copies a shortcut创建/复制快捷方式
• writes the security settings for the application in the Registry将应用程序的安全设置写入注册表中
• launches the application (which then launches the background application)启动应用程序（然后启动后台应用程序）

The result is, that the user at each launch updates the application, thus deployment of new application versions is "automatic". Please study the in-line comments for details.

结果是，用户在每次启动时都会更新应用程序 ，因此新应用程序版本的部署是“自动的”。 请研究在线注释以获取详细信息。

Option Explicit
' Launch script for PPT test/development/operation.
' Version 1.3.0
' 2013-09-15
' Cactus Data. Gustav Brock
Const DESKTOP = &H10
Const LOCALAPPDATA = &H1C
Dim objFSO
Dim objAppShell
Dim objDesktopFolder
Dim objLocalAppDataFolder
Dim objLocalFolder
Dim objRemoteFolder
Dim strLocalFolder
Dim strRemoteFolder
Dim strDesktopFolder
Dim strLocalAppDataFolder
Dim strLocalAppDataDsgFolder
Dim strLocalAppDataDsgPptFolder
Dim strDsgSubfolder
Dim strPptSubfolder
Dim strPptAppSubfolder
Dim strPptNcSuffix
Dim strAppName
Dim strAppSuffix
Dim strShortcutName
Dim strAppLocalPath
Dim strAppLocalBackPath
Dim strAppRemotePath
Dim strShortcutLocalPath
Dim strShortcutRemotePath
Dim strRegPath
Dim strRegKey
Dim strRegValue
Dim booNoColour
Dim varValue
' Adjustable parameters.
strDsgSubfolder = "DSG"
strPptSubfolder = "PPT"
strPPtNcSuffix = "NC"
' ---------------------------------------------------------------------------------
' Uncomment one folder name only:
'strPptAppSubfolder = "Development"
strPptAppSubfolder = "Operations"
'strPptAppSubfolder = "Test"
' ---------------------------------
' Indicate if the script is for the normal version (0) or the no-colour version (1):
booNoColour = 0
' ---------------------------------------------------------------------------------
strRemoteFolder = "K:\_Shared\Sales Planning\Environments\" & strPptAppSubfolder
If booNoColour = 1 Then
strAppSuffix = strPptNcSuffix
Else
strAppSuffix = ""
End If
strAppName = "SalesPlanningTool" & strAppSuffix & ".accdb"
If strPptAppSubfolder = "Operations" Then
If strAppSuffix = "" Then
strShortcutName = "RunPPT.lnk"
Else
strShortcutName = "RunPPT " & strAppSuffix & ".lnk"
End If
Else
If strAppSuffix = "" Then
strShortcutName = "RunPPT " & strPptAppSubfolder & ".lnk"
Else
strShortcutName = "RunPPT " & strAppSuffix & " " & strPptAppSubfolder & ".lnk"
End If
End If
' Enable simple error handling.
On Error Resume Next
' Find user's Desktop and AppData\Local folder.
Set objAppShell = CreateObject("Shell.Application")
Set objDesktopFolder = objAppShell.Namespace(DESKTOP)
strDesktopFolder = objDesktopFolder.Self.Path
Set objLocalAppDataFolder = objAppShell.Namespace(LOCALAPPDATA)
strLocalAppDataFolder = objLocalAppDataFolder.Self.Path
' Dynamic parameters.
strLocalAppDataDsgFolder = strLocalAppDataFolder & "\" & strDsgSubfolder
strLocalAppDataDsgPptFolder = strLocalAppDataDsgFolder & "\" & strPptSubfolder
strLocalFolder = strLocalAppDataDsgPptFolder & "\" & strPptAppSubfolder
strAppLocalPath = strLocalFolder & "\" & strAppName
strShortcutLocalPath = strDesktopFolder & "\" & strShortcutName
' Permanent parameters.
strAppRemotePath = strRemoteFolder & "\" & strAppName
strShortcutRemotePath = strRemoteFolder & "\" & strShortcutName
' Create the File System Object.
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FolderExists(strRemoteFolder) Then
Call ErrorHandler("No access to " & strRemoteFolder & ".")
Else
Set objRemoteFolder = objFSO.GetFolder(strRemoteFolder)
' If local folder does not exist, create the folder.
If Not objFSO.FolderExists(strLocalFolder) Then
If Not objFSO.FolderExists(strLocalAppDataDsgFolder) Then
Set objLocalFolder = objFSO.CreateFolder(strLocalAppDataDsgFolder)
If Not Err.Number = vbEmpty Then
Call ErrorHandler("Folder " & strLocalAppDataDsgFolder & " could not be created.")
End If
End If
If Not objFSO.FolderExists(strLocalAppDataDsgPPtFolder) Then
Set objLocalFolder = objFSO.CreateFolder(strLocalAppDataDsgPptFolder)
If Not Err.Number = vbEmpty Then
Call ErrorHandler("Folder " & strLocalAppDataDsgPptFolder & " could not be created.")
End If
End If
If Not objFSO.FolderExists(strLocalFolder) Then
Set objLocalFolder = objFSO.CreateFolder(strLocalFolder)
If Not Err.Number = vbEmpty Then
Call ErrorHandler("Folder " & strLocalFolder & " could not be created.")
End If
End If
End If
Set objLocalFolder = objFSO.GetFolder(strLocalFolder)
End If
If Not objFSO.FileExists(strAppRemotePath) Then
Call ErrorHandler("The application file:" & vbCrLf & strAppRemotePath & vbCrLF & "could not be found.")
Else
' Close a running PPT.
Call KillTask("PPT")
' Wait while TaskKill is running twice to close the instance(s) of PPT and PPT Background.
Call AwaitProcess("taskkill.exe")
Call KillTask("PPT Background")
' Wait while TaskKill is running twice to close the instance(s) of PPT and PPT Background.
Call AwaitProcess("taskkill.exe")
' Copy app to local folder.
If objFSO.FileExists(strAppLocalPath) Then
objFSO.DeleteFile(strAppLocalPath)
If Not Err.Number = 0 Then
Call ErrorHandler("The application file:" & vbCrLf & strAppName & vbCrLF & "can not be refreshed/updated. It may be in use.")
End If
End If
If objFSO.FileExists(strAppLocalPath) Then
Call ErrorHandler("The local application file:" & vbCrLf & strAppLocalPath & vbCrLF & "could not be replaced.")
Else
objFSO.CopyFile strAppRemotePath, strAppLocalPath
If Not Err.Number = vbEmpty Then
Call ErrorHandler("Application could not be copied to " & strLocalFolder & ".")
End If
' Create copy for PPT Background.
strAppLocalBackPath = Replace(Replace(strAppLocalPath, ".accdb", ".accbg"), "SalesPlanningTool", "SalesPlanningToolBack")
objFSO.CopyFile strAppLocalPath, strAppLocalBackPath
If Not Err.Number = vbEmpty Then
Call ErrorHandler("Background application could not be copied to " & strLocalFolder & ".")
End If
End If
' Copy shortcut.
objFSO.CopyFile strShortcutRemotePath, strShortcutLocalPath
If Not Err.Number = vbEmpty Then
Call ErrorHandler("Shortcut could not be copied to your Desktop.")
End If
End If
' Write Registry entries for Access security.
strRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\Access\Security\"
strRegValue = "VBAWarnings"
strRegPath = strRegKey & strRegValue
varValue = 1
Call WriteRegistry(strRegPath, varValue,"REG_DWORD")
strRegKey = strRegKey & "Trusted Locations\LocationLocalAppData\"
strRegValue = "AllowSubfolders"
strRegPath = strRegKey & strRegValue
varValue = 1
Call WriteRegistry(strRegPath, varValue, "REG_DWORD")
strRegValue = "Date"
strRegPath = strRegKey & strRegValue
varValue = Now
varValue = FormatDateTime(varValue, vbShortDate) & " " & FormatDateTime(varValue, vbShortTime)
Call WriteRegistry(strRegPath, varValue, "REG_SZ")
strRegValue = "Description"
strRegPath = strRegKey & strRegValue
varValue = "Local AppData"
Call WriteRegistry(strRegPath, varValue, "REG_SZ")
strRegValue = "Path"
strRegPath = strRegKey & strRegValue
varValue = strLocalAppDataFolder & "\"
Call WriteRegistry(strRegPath, varValue, "REG_SZ")
' Run PPT.
If objFSO.FileExists(strAppLocalPath) Then
Call RunApp(strAppLocalPath, False)
Else
Call ErrorHandler("The local application file:" & vbCrLf & strAppLocalPath & vbCrLF & "could not be found.")
End If
Set objRemoteFolder = Nothing
Set objLocalFolder = Nothing
Set objLocalAppDataFolder = Nothing
Set objDesktopFolder = Nothing
Set objAppShell = Nothing
Set objFSO = Nothing
WScript.Quit
' Supporting subfunctions
' -----------------------
Sub RunApp(ByVal strFile, ByVal booBackground)
Dim objShell
Dim intWindowStyle
' Open as default foreground application.
intWindowStyle = 1
Set objShell = CreateObject("WScript.Shell")
objShell.Run Chr(34) & strFile & Chr(34), intWindowStyle, False
Set objShell = Nothing
End Sub
Sub KillTask(ByVal strWindowTitle)
Dim objShell
Set objShell = CreateObject("WScript.Shell")
objShell.Run "TaskKill.exe /FI ""WINDOWTITLE eq " & strWindowTitle & """", 7, False
Set objShell = Nothing
End Sub
Sub AwaitProcess(ByVal strProcess)
Dim objSvc
Dim strQuery
Dim colProcess
Dim intCount
Set objSvc = GetObject("winmgmts:root\cimv2")
strQuery = "select * from win32_process where name='" & strProcess & "'"
Do
Set colProcess = objSvc.Execquery(strQuery)
intCount = colProcess.Count
If intCount > 0 Then
WScript.Sleep 300
End If
Loop Until intCount = 0
Set colProcess = Nothing
Set objSvc = Nothing
End Sub
Sub WriteRegistry(ByVal strRegPath, ByVal varValue, ByVal strRegType)
' strRegType 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 objShell
Set objShell = CreateObject("WScript.Shell")
Call objShell.RegWrite(strRegPath, varValue, strRegType)
Set objShell = Nothing
End Sub
Sub ErrorHandler(Byval strMessage)
Set objRemoteFolder = Nothing
Set objLocalFolder = Nothing
Set objLocalAppDataFolder = Nothing
Set objDesktopFolder = Nothing
Set objAppShell = Nothing
Set objFSO = Nothing
WScript.Echo strMessage
WScript.Quit
End Sub

(
)

部署 (To deploy)

Place the script and a shortcut in a shared folder and send the users a link this read-only copy of the script. When double-clicked, it will run and create a shortcut on the user's desktop for future launch of the application.

将脚本和快捷方式放置在共享文件夹中，并向用户发送此脚本的只读副本的链接。 双击后，它将运行并在用户的桌面上创建快捷方式，以供将来启动该应用程序。

Discuss with your Citrix system people If further protection of the script is necessary. All the users really need is the right to execute it.

与Citrix系统人员讨论是否需要进一步保护脚本。 用户真正需要的只是执行它的权利。

The users of the organisation for which the script was originally created, had Access 2010  installed by default so no runtime was needed. If that is not so for your case, you must modify the script to check for the runtime environment and install it if it is missing, or arrange with the Citrix system people for a pre-install of the runtime for the relevant users.

最初为其创建脚本的组织的用户默认情况下安装了Access 2010 ，因此不需要运行时。 如果您的情况并非如此，则必须修改脚本以检查运行时环境并在缺少时进行安装，或者与Citrix系统人员安排为相关用户预安装运行时。

Of course, if your application does not require a "background task" running (most won't), you can omit those parts of the script dealing with this. All you have to do, is to comment out or delete those lines dealing with the background copy.

当然，如果您的应用程序不需要运行“后台任务”（大多数情况下不需要），则可以省略脚本中处理该任务的那些部分。 您要做的就是注释掉或删除那些与背景副本有关的行。

(
)

下载 (Download)

The VBScript can be copy-pasted from above or from here: Script.txt

可以从上方或此处复制粘贴VBScript： Script.txt

Rename it as .vbs after download.

下载后将其重命名为.vbs。

I hope you found this article useful. You are encouraged to ask questions, report any bugs or make any other comments about it below.

希望本文对您有所帮助。 鼓励您在下面提出问题，报告任何错误或对此作出任何其他评论。

Note: If you need further "Support" about this topic, please consider using the Ask a Question feature of Experts Exchange. I monitor questions asked and would be pleased to provide any additional support required in questions asked in this manner, along with other EE experts.

注意 ：如果您需要有关此主题的更多“支持”，请考虑使用Experts Exchange 的“提问”功能。 我会监督提出的问题，并很高兴与其他电子工程师一起为以这种方式提出的问题提供所需的任何其他支持。

Please do not forget to press the "Thumbs Up" button if you think this article was helpful and valuable for EE members.

如果您认为本文对EE成员有用且有价值，请不要忘记按下“竖起大拇指”按钮。

翻译自: https://www.experts-exchange.com/articles/23959/Deploy-and-update-a-Microsoft-Access-application-in-a-Citrix-environment.html

citrix应用程序虚拟化