'====================================================================
' Project: Company Operations Database (Office365 - Access 2019)
' Title: Company Operations Launch Script
' Filename: CompanyOpLaunch.vbs
' Creation Date: 06/10/2021
' Revision Date: 09/22/2022
' Author: jmongi
' Purpose: Launches 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
' --ScriptSetup: Initialize constants, objects and variables used throughout the script
' --LocationChk: Verify and create directory locations
' --RuntimeChk: Checks that MS Access runtime is installed
' --WiFiChk: Check if WiFi is in use and provide prompts
' --FileXfer: Copy files from server location to local user
' --LaunchApp: Launch the application automatically
' --WriteLog: Writes a string to a specified text log file
' --ErrHandler: Manage errors that occur
'==================================================================================================================================
Option Explicit
OnError Resume Next 'errors will not halt script, see ErrHandler sub
Dim sModuleName 'Used with ErrHandler
sModuleName = "Main Script"
Call ScriptSetup
Call LocationChk
Call FileXfer
'Call RuntimeChk
'Call WiFiChk
Call LaunchApp
Call WriteLog (sLogfile, sStartLog)
Exit Script
' Subroutine Modules
'==================================================================================================================================
Sub ScriptSetup' Script Initialization
sModuleName = "Script Initialization"
'Set Constants
Const cFE = "test.txt" 'Front End filename
Const cIcon = "MainApp.ico" 'Icon name
Const cServerPath = "\\XXXXX\testfolder" '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 cSCName = "Company Operations" 'Shortcut name
Const cScriptName = "CompanyOpLaunch.vbs" 'Name of this script
'Scriptwide varirables
Dim sLocalApp
Dim sLocalUser
Dim sLocalFE
Dim sLocalLog
Dim sLocalArchive
Dim sStartText
'Instantiate various objects for use throughout the script
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("%USERPROFILE%")
sLocalApp = sLocalUser & cLocalApp
sLocalFE = sLocalUser & cLocalApp & cLocalFE
sLocalLog = sLocalUser & cLocalApp & cLocalLog
sLocalArchive = sLocalUser & cLocalApp & cLocalArchive
sStartLog = Now() & " Database Launch Successful"
End Sub
'==================================================================================================================================
Sub LocationChk () ' Check if installation folders exist and create them if they do not exist
sModuleName = "LocationChk"
Dim aNewFolder
Dim i
aNewFolder = Array(sLocalApp, sLocalFE, sLocalLog, sLocalArchive)
For i = 0 to UBound(aNewFolder)
If Not oFSO.FolderExists(aNewFolder) Then
oFSO.CreateFolder (aNewFolder)
call ErrHandler (sModuleName)
End If
Next
End Sub
'==================================================================================================================================
Sub RuntimeChk () ' Checks if the appropriate Access runtime exists
'Check if Microsoft 365 Access Runtime is installed
End Sub
'==================================================================================================================================
Sub WiFiChk () ' Check if WiFi is the main connection
'Script taken from randlotech.blogspot.com/2015/05/vbscript-to-check-wireless-or-wired.html
' NAME: Check Connection Type
' AUTHOR: Mark Randol
' DATE : 4/29/2015
' COMMENT: this script will return
' 1 if both are in use (shouldn't happen, but can)
' 2 if wired LAN adapter is in use
' 3 if wireless LAN adapter is in use
' 4 if none of the LAN adapters are in use.
'
'Modified/updated 06/21/2021 by jmongi
Dim strComputer, strOut
Dim objWMIService, objWifi, objLAN
Dim colWiFi, colLAN
Dim state, wireStatus, wifiStatus
Dim intOutput
' Initialize Variables
sModuleName = "WiFiChk"
intOutput = 4
state = ""
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Call ErrHandler (sModuleName)
Set colLAN = objWMIService.ExecQuery("Select * From Win32_NetworkAdapter Where NetConnectionStatus = 2 and PhysicalAdapter = 'True'")
Call ErrHandler (sModuleName)
' Enumerate the wired adapters in WMI. Add 1 to output if wired adapter is in use.
For Each objLAN in colLAN
strOut = objLAN.NetConnectionID & " " & objLAN.Name & " " & objLAN.PhysicalAdapter
if instr(lcase(objLAN.Name),"virtual") = 0 and instr(lcase(objLAN.Name),"multiplex") = 0 and instr(lcase(objLAN.Name),"bridge") = 0 then
' Above line (if statement) is there to eliminate other extraneous adapters that
' still show up even though we are eliminating all but "physical" adapters. Some
' virtual adapters are still there, Microsoft being the biggest offender.
' Add to the line if necessary to remove other non-physical adapters.
if instr(lcase(objLAN.NetConnectionID),"wireless") > 0 or instr(lcase(objLAN.NetConnectionID),"wi*fi") > 0 then
intOutput = intOutput - 2
Call ErrHandler (sModuleName)
Wscript.Echo(strOut & " connected. Output is now " & intOutput)
end if
if instr(lcase(objLAN.NetConnectionID),"wireless") = 0 and instr(lcase(objLAN.NetConnectionID),"wi*fi") = 0 Then
intOutput = intOutput - 1
Call ErrHandler (sModuleName)
Wscript.Echo(strOut & " connected. Output is now " & intOutput)
end if
end if
Next
Select Case intOutput
Case 1
Dim MboxPrompt, MboxTitle, MboxButton
MboxPrompt = "Please disconnect from WiFi before using this application."
MboxTitle = "WARNING - WiFi In Use"
MboxButton = 16
MsgBox (MboxPrompt, MboxButton, MboxTitle)
'Log Startup Code
Wscript.quit
Case 2
'Do nothing and continue script
Case 3
Dim MboxPrompt, MboxTitle, MboxButton
MboxPrompt = "Please disconnect from WiFi and connect via ethernet cable to the local network before using this application."
MboxTitle = "WARNING - WiFi In Use"
MboxButton = 16
MsgBox (MboxPrompt, MboxButton, MboxTitle)
'Log Startup Code
Wscript.quit
Case 4
'Code for cancel launch
'No network warning
End Sub
'==================================================================================================================================
Sub FileXfer () 'Transfer new files from shared network location to local user
sModuleName = "FileXfer"
oFSO.CopyFile cServerPath & "\*.*", sLocalFE & "\", True 'The true flag suppresses the user prompt for overwrite
Call ErrHandler (sModuleName)
End Sub
'==================================================================================================================================
Sub LaunchApp () 'Launch the Access Database
sModuleName = "LaunchApp"
WScript.Sleep 5000 'Pause to make sure MSAccess does not open before filecopy is finished.
Call ErrHandler (sModuleName)
WSHShell.Run cLocalFE & "\" & cSCName & ".lnk"
Call ErrHandler (sModuleName)
End Sub
'==================================================================================================================================
Sub WriteLog (ByVal LogName, ByVal WriteText)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateFalse = 0, TristateTrue = -1, TristateUseDefault = -2
Dim f
Set f=oFSO.OpenTextFile(LogName, For Appending, TristateFalse, True)
f.WriteLine WriteText
f.Close
End Sub
'==================================================================================================================================
Sub ErrHandler (ByVal ErrModule) 'Custom error handler for VBScript
If Err.Number <> 0 Then
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateFalse = 0, TristateTrue = -1, TristateUseDefault = -2
Dim sError, f, sLinetext, sLogfile
'Store the error
sError = "Error No:" & Err.Number & " - " & Err.Description & " occurred in module " & ErrModule
Err.Clear
'Notify the user of the error.
MsgBox "An error has occurrred launching the program. The program will attempt to recover. " _
& "If the error occurs again, please contact your system administrator."
'Log the error
sLinetext = Now() & " " & sError
sLogfile = cLocalLog & "\startuplog.txt"
Call WriteLog(sLogfile, sLinetext)
End If
'==================================================================================================================================