使用SQL后端将Access 2007数据库部署到Citrix以供多个用户使用

时间：2015-12-04 21:37:51

标签： sql-server-2008 odbc ms-access-2010 ms-access-2007 citrix

场合：     我最近在我的公司（旧的所有者离开）获得了IT Support对我们的时间跟踪数据库的所有权。这是在Access 2007中编写的，并在后端使用SQL Server 2008 R2表和视图。我们向Citrix服务器场发布了一个锁定的（db.accde）版本，用户通过登录Citrix Web门户并单击Access数据库的图标来访问它。我需要将其从一次服务器移动到另一台服务器，以便旧的可以是日落。我尝试将现有服务器上的文件复制到新服务器（运行Office 2010应用程序）并在citrix门户上创建一个新图标以指向它。

问题：     现在它只有一个人可以一次打开它（以前可供多个用户使用）它还需要知道我是谁（在DB中具有适当的权限）并且它似乎没有线索。它给出了与SQL连接相关的错误。它确定你是谁以及你应该拥有什么权限的方式是检查Active Directory，如果你属于正确的NT组，那么你可以访问其他表单，如果不是，你只能看到基本的用户表单。现在，从Citrix打开它的每个人都只能看到＆＃34;基本用户表单＆＃34;无论他们被分配到哪个NT组。

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

如果有人有任何专业知识，他们可以折腾我的方式来帮助我走上正确的道路来解决这个问题，我们将不胜感激。

1 个答案:

答案 0 :(得分：2)

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

＆＃34;技巧＆＃34;是使用用户的 LocalAppData 文件夹来托管accdb文件，因为用户始终在此处被授予完整权限。

它从第一次尝试起作用。版本号由较小的更改引起，包括仅更改本地文件夹的名称。

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

脚本执行以下任务：

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

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

请详细阅读在线评论。

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
相关问题
最新问题