Batch file 是否通过批处理文件更新Access前端？

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

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

---

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

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

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

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

---

通过更改图标修饰批处理文件快捷方式的额外积分：右键单击|属性|更改图标。。。按钮

为此，我使用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等版本，以便更好地跟踪。

< P>本文可以找到一个很好的文章：

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

---

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

批处理文件不是EXE文件。批处理文件是在运行时解释的脚本。如果要复制文件，这是批处理文件中的一行代码。复制\\10.0.0.0.5\Data\DB\Database.accdb c:\DB\I以前使用代码复制更新的前端，直到它收紧用户权限，并且代码无法再复制/保存文件。复习谢谢。。。。我知道.bat和.exe文件之间的区别。我的评论反映了我的理想。

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