VB script to run MS Access Project application

The following VB script add registry key Trusted Locations for this application, creates destination folder on the desktop, copyes MS Access Project application file on the desktop and runs the application:

Option Explicit

'This Script runs AppName.ade
Dim objFSO, objShell, fromPath, toPath, fName, iPos, objFile
Dim filesys, regFile, fromFile, toFile, strComputer
Dim objWMIService, colProcessList, objProcess, id

 fromPath = "j:\databases\AppName\"
 toPath = "e:\App\" ' Trailing \ is required
 fName = "AppName"
 regFile = fromPath & fName & ".reg"
 fromFile = fromPath & fName & ".ade"
 toFile = toPath & fName & ".ade"
 'regKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Access\Security\Trusted Locations\Location0\Path" 'Access 2007
 regKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\13.0\Access\Security\Trusted Locations\Location0\Path" 'Access 2010

 'Add registry key TrustedLocations for this application
 If Err.number = vbEmpty Then
  Set objShell = CreateObject("WScript.Shell")
  objShell.RegWrite regKey, toPath, "REG_SZ"
 Else WScript.echo "VBScript Error: " & err.number
 End If

 'Create destination folder on the desktop
 iPos = InStr(4, toPath, "\", 0) ' Skip drive letter check
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 While(iPos <> 0)
     If(Not(objFSO.FolderExists(Left(toPath, iPos)))) Then
        objFSO.CreateFolder(Left(toPath, iPos))
     End If
     iPos = InStr(iPos+1, toPath, "\", 0)
 Wend

 'Copy application file on the desktop
 Set objFile = objFSO.GetFile(fromFile)
 objFile.Copy toFile, True
 'Run the application
 If Err.number = vbEmpty Then
  objShell.run ("msaccess " & toFile)
 Else WScript.echo "VBScript Error: " & err.number
 End If
 Set objFile = Nothing
 Set objShell = Nothing
 Set objFSO = Nothing
 WScript.Quit

If you find this script useful please donate generously.