Question

查看用户是否可以通过单击按钮更新其MS Access数据库前端。然后该按钮将触发一个批处理文件，该文件将从我们服务器上的某个位置获取文件，并覆盖用户本地PC上的当前数据库。所有这些都在一个办公室内完成，因此网络地址将完全相同。

要复制的文件的位置：10.0.0.0.5 / Data / DB / Database.accdb 要覆盖的文件的位置：c：\ DB \ Database.accdb

有什么想法吗？理想情况下，我希望有人写一个很好的exe文件，删除旧版本并安装较新版本，但不能编写那种代码。

Answer 1

编写批处理文件以从其源代码检索前端的较新版本，并将其复制到前端文件的用户副本所在的文件夹中。在批处理文件末尾添加一行，以使用前端程序的文件名command line parameter启动msacess.exe。

批处理文件可以位于任何位置，但我建议将其放在应用程序前端所在的文件夹中。

创建批处理文件的Windows快捷方式，可以将其放在用户的桌面上或用户希望启动应用程序的任何其他位置。

通过更改图标来装饰批处理文件快捷方式的加分点：右键单击|属性|更改图标...按钮。

Answer 2

我为此目的使用了一个vbscript。我只更新了要复制的文件的路径，然后我向用户发送了一封电子邮件，其中包含指向该脚本的链接。用户单击该链接并执行脚本。

将下面的代码复制到文本文件并将其另存为.vbs。不要忘记设置要复制的文件路径。

Option Explicit
Call Main()

Private Sub Main()

    const folderFrom = "\\Somepath\Somefolder\"     'Folder: Must supply backslash
    const fileName = "SomeFile.accdb"               'File name with extension
    const overwrite = -1                            'OverWrite = True

    'Ask user to proceed
    dim msg
    msg = "The script will copy the file below to your desktop. " & vbNewLine & vbNewLine & _
          String(75,"_") & vbNewLine & vbNewLine & _
          "File: " & " " & " " & " " & " " & " " & " " & " '" & fileName & "' " & vbNewLine & _
          "Folder: " & " " & " '" & folderFrom & "' " & vbNewLine & _
          String(75,"_") & vbNewLine & vbNewLine & _
          "Proceed?"
    if MsgBox(msg, vbYesNo + vbQuestion, "FileCopy Confirmation") = vbNo then exit sub

    on error resume next
    dim filesys
    set filesys = CreateObject("Scripting.FileSystemObject")

    'File exists in folder?
    if not filesys.FileExists(folderFrom & fileName) then
        MsgBox "File not found. Task aborted. ", vbOKOnly + vbExclamation, "Attention:"
        exit sub
    end if

    'User's desktop path
    dim desktopPath
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"

    'Copy file
    filesys.CopyFile folderFrom & fileName, desktopPath & fileName, overwrite

    'Validate file copied
    if filesys.FileExists(desktopPath & fileName) then
        Msgbox "File copied successfully.", vbOKOnly + vbInformation, "Success!"
    else
        MsgBox "File could not be copied... ", vbOKOnly + vbExclamation, "Copy Failed..."
    end if
End Sub

建议：

您不应该覆盖现有的前端数据库，而应该考虑版本化，例如v2.0，v2.1，v2.2等，以便更好地跟踪。

Answer 3

关于这个主题的一篇很好的文章可以在这里找到：

Deploy and update a Microsoft Access application in a Citrix environment

它既不使用bat也不使用exe，而是使用 VBscript ：

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

您可以将其转换为 PowerShell ，我今天会使用它。

通过批处理文件更新Access前端？

3 个答案: