'====================================================================
' Project: Company Operations Database (Office365 - Access 2019)
' Title: Company Operations Install Script
' Filename: CompanyOpInstall.vbs
' Creation Date: 09/26/2022
' Revision Date: -
' Author: jmongi
' Purpose: Installs the Company Operations Application
' Acknowledgments: Thanks to the users of AccessWorld Forums at www.access-programmers.co.uk for help with
' development and testing. Users include but are not limited to theDBguy, Isaac, isladogs,
' gasman, cheekybuddha, arnelgp, Minty
' Module List
' --LocationChk: Verify and create directory locations
' --RuntimeChk: Checks that MS Access runtime is installed
' --FileXfer: Copy files from server location to local user
' --WriteLog: Writes a string to a specified text log file
' --ErrHandler: Manage errors that occur
'=====================================================================================================
Option Explicit
On Error Resume Next 'errors will not halt script, see ErrHandler sub
Dim sModuleName 'Used with ErrHandler
sModuleName = "Main Script"
'Set Constants
Const cIcon = "MainApp.ico" 'Shortcut Icon
Const cSCName = "CompanyOperations" 'Shortcut name
Const cServerPath = "\\SERVER\PersonalFolders\ProductionFE\" 'Front End Server Path
Const cLocalApp = "\CompanyOp\" 'Local App Folder Name
Const cLocalFE = "FE\" 'Front End Local Folder Name
Const cLocalLog = "Log\" 'Application Log Local Folder Name
Const cLocalArchive = "Archive\" 'Applicaton Archive Local Folder Name
Const cScriptName = "CompanyOpLaunch.vbs" 'Name of this script
'Scriptwide varirables
Dim sLocalUser
Dim sLocalApp
Dim sLocalFE
Dim sLocalLog
Dim sLocalArchive
Dim sIconLoc
Dim oShell
Set oShell = CreateObject("WScript.Shell")
Call ErrHandler(sModuleName)
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
Call ErrHandler(sModuleName)
'Set user variables
sLocalUser = oShell.ExpandEnvironmentStrings("%AppData%")
sLocalApp = sLocalUser & cLocalApp
sLocalFE = sLocalUser & cLocalApp & cLocalFE
sLocalLog = sLocalUser & cLocalApp & cLocalLog
sLocalArchive = sLocalUser & cLocalApp & cLocalArchive
sIconLoc = sLocalFE & cIcon
Call ErrHandler (sModuleName)
Call LocationChk
Call FileXfer
Call CreateSC
MsgBox "Installation Successful!"
WScript.Quit
' Subroutine Modules
'===================================================================================================
Sub RuntimeChk
sModuleName = "RuntimeChk"
'Some code to check Access runtime
End Sub
'====================================================================================================
Sub ErrHandler (ByVal ErrModule) 'Custom error handler for VBScript
Dim sError
If Err.Number <> 0 Then
'Store the error
sError = "Error No:" & Err.Number & " - " & Err.Description & " occurred in module " & ErrModule
MsgBox sError
Err.Clear
'Notify the user of the error.
MsgBox "An error has occurrred installing the program. The installation will attempt to recover. " _
& "If the error occurs again, please contact your system administrator."
End If
End Sub
'=====================================================================================================
Sub LocationChk () ' Check if installation folders exist and create them if they do not exist
sModuleName = "LocationChk"
Dim i
Dim aNewFolder
aNewFolder = Array(sLocalApp, sLocalFE, sLocalLog, sLocalArchive)
For i = 0 To 3
If Not oFSO.FolderExists(aNewFolder(i)) Then
MsgBox aNewFolder(i)
oFSO.CreateFolder (aNewFolder(i))
End If
Next
Call ErrHandler (sModuleName)
End Sub
'=====================================================================================================
Sub FileXfer () 'Transfer new files from shared network location to local user
sModuleName = "FileXfer"
Dim Source, Destination
Source = cServerPath & "*.*"
Destination = sLocalFE
oFSO.CopyFile Source, Destination, True 'The true flag suppresses the user prompt for overwrite
Call ErrHandler (sModuleName)
End Sub
'=====================================================================================================
Sub CreateSC ()
sModuleName = "CreateSC"
Dim sDesktopPath, sSCPath, sSCTarget
Dim link
sDesktopPath = oShell.SpecialFolders("Desktop")
sSCPath = sDesktopPath & "\" & cSCName & ".lnk"
sSCTarget = sLocalFE & cScriptName
If Not oFSO.FileExists(sSCPath) Then
Set link = oShell.CreateShortcut(sSCPath)
link.TargetPath = sSCTarget
link.Description = cSCName
link.IconLocation = sIconLoc & ", 0"
link.Save
End If
Call ErrHandler(sModuleName)
End Sub