'====================================================================
' 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
'==================================================================================================================================