将Access 2007 Database with SQL后端部署到Citrix以供多个用户使用

Question

情况：我最近在公司获得了时间跟踪数据库的IT支持所有权（老东家离开了）。这是在Access 2007中编写的，在后端使用SQL Server 2008 R2表和视图。我们将锁定的（db.accde）版本发布到Citrix服务器场，用户通过登录Citrix门户并单击access Database的图标来访问它。我需要把它从一个服务器移到另一个服务器，这样旧的服务器就可以日落了。我试着简单地将现有服务器上的文件复制到新服务器上（该服务器正在运行Office 2010应用程序），并在citrix门户网站上创建一个新图标来指向它。

问题：现在它在那里，一次只有一个人可以打开它（过去可以由多个用户使用）。它还需要知道我是谁（在数据库中获得适当的权限），而且它似乎没有任何线索。它给出了与SQL连接相关的错误。它计算你是谁以及你应该拥有什么权限的方法是通过检查Active Directory，如果你属于正确的NT组，那么你就可以访问其他表单，如果你不能只看到基本的用户表单。现在，每个从Citrix打开它的人都只能看到"基本用户表单"，而不管它们被分配到哪个NT组。

问题：在Access和VB方面，我不是一个高级开发人员。我对Citrix的工作原理也知之甚少。我想知道，当我将数据库复制到新服务器时，如果有什么事情我没有做，那是否应该发生。例如，当您打开"现有链接"，打开"现有访问数据库"一秒钟时，会弹出一个CMD屏幕，并在访问数据库打开之前消失。在没有发生的新链接上。

如果有人有任何专业知识，他们可以通过我的方式帮助我走上正确的道路，我将不胜感激。

Answer 1

由于各种原因，它是VBscriptPowerShell也可以使用。

"诀窍"是使用用户的LocalAppData文件夹来托管accdb文件，因为用户在这里总是被授予完全权限。

它从第一次尝试就成功了。版本号是由微小的更改引起的，仅包括更改了本地文件夹的名称。

用户收到了一个指向共享文件夹中脚本只读副本的链接，双击后，在用户桌面上运行并创建了一个快捷方式，以便将来启动应用程序。默认情况下，用户已安装Access 2010，因此不需要运行时。

脚本执行以下任务：

• 在用户的LocalAppData文件夹中创建子文件夹
• 如果应用程序正在运行，则会终止该应用程序
• 将应用程序的当前版本复制到本地文件夹
• 复制第二个副本（由第一个启动用于后台任务）
• 创建/复制快捷方式
• 在注册表中写入应用程序的安全设置
• 启动应用程序（然后启动后台应用程序）

结果是，用户在每次启动时都会更新应用程序，因此新应用程序版本的部署是"自动的"。

请研究在线评论以了解详细信息。

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:_SharedSales PlanningEnvironments" & 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 AppDataLocal 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_USERSoftwareMicrosoftOffice14.0AccessSecurity"
strRegValue = "VBAWarnings"
strRegPath = strRegKey & strRegValue
varValue = 1
Call WriteRegistry(strRegPath, varValue,"REG_DWORD")
strRegKey = strRegKey & "Trusted LocationsLocationLocalAppData"
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:rootcimv2")
  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