SG Corporate Intranet

'================================================================== '(c) 2003 SG Industries, Inc., SG Electronics, Inc. 'Project : Corporate Intranet Site 'File Name : common.vb 'Purpose : Common, shared VbScript functions and procedures. 'Author : Lance Denton 'Date : 06/10/2005 '================================================================== Dim goWaitMsg 'global hook for VbsShowWaitMsg and VbsShowErrMsg... Sub VbsOpenWaitMsg() '========================================================== 'Function Name : VbsOpenWaitMsg 'Purpose : Open new window as a wait message. '========================================================== Dim lcWinType lcWinType = "menubar=no," & _ "toolbar=no," & _ "resizable=no," & _ "scrollbars=yes," & _ "status=0," & _ "width=500," & _ "height=200," & _ "top=100," & _ "left=100" Set goWaitMsg = window.open("","",lcWinType) goWaitMsg.document.write("") End Sub Sub VbsShowWaitMsg(pcMsg) '========================================================== 'Function Name : VbsShowWaitMsg 'Purpose : Display wait message to user. 'Parameters : pcMsg = message '========================================================== goWaitMsg.document.body.innerHTML = _ "" & pcMsg & "" & _ "

" & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ " " & _ "" End Sub Sub VbsShowErrMsg(pcMsg) '========================================================== 'Function Name : VbsShowErrMsg 'Purpose : Display error message to user. 'Parameters : pcMsg = message '========================================================== goWaitMsg.document.body.innerHTML = _ "" & pcMsg & "" End Sub Sub VbsOpenStatMsg(pcTitle) '========================================================== 'Function Name : VbsOpenStatMsg 'Purpose : Open new window as a status message. '========================================================== Dim lcWinType lcWinType = "menubar=no," & _ "toolbar=no," & _ "resizable=no," & _ "scrollbars=yes," & _ "status=0," & _ "width=550," & _ "height=300," & _ "top=100," & _ "left=100" Set goWaitMsg = window.open("","",lcWinType) goWaitMsg.document.write("" & _ "" & vbcrlf & _ "SG Corporate Intranet" & vbcrlf & _ "" & vbcrlf & _ "" & vbcrlf & _ "" & vbcrlf & _ "" & vbcrlf & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "" & _ "
" & pcTitle & " (" & Now() & ")
" & _ "" & vbcrlf & _ "") End Sub Sub VbsOpenLink(pcLink,pnBehavior) '========================================================== 'Function Name : VbsOpenLink 'Purpose : Open a URL 'Parameters : pcLink = url 'Parameters : pnBehavior = 1 open in current window, ' 2 open in a new window '========================================================== Dim loWindow Dim loProcLog If pnBehavior = 1 Then location.href = pcLink Else Set loWindow = window.Open(pcLink) End If 'on error resume next 'Set loProcLog = CreateObject("ProcessLog.Scriptlet") 'If err.number = 0 Then ' loProcLog.DSN = "ProcessLog" ' Call loProcLog.PostMessage("Hyperlink Usage", _ ' "LinkMngr", _ ' pcLink) ' Set loProcLog = Nothing 'End If End Sub Sub VbsOpenFolder(pcFldPath) '========================================================== 'Function Name : VbsOpenFolder 'Purpose : Open a folder in windows explorer 'Parameters : pcFldPath = path to folder '========================================================== Dim loShell Dim loProcLog Set loShell = CreateObject("Shell.Application") loShell.Explore(pcFldPath) on error resume next Set loProcLog = CreateObject("ProcessLog.Scriptlet") If err.number = 0 Then loProcLog.DSN = "ProcessLog" Call loProcLog.PostMessage("Hyperlink Usage", _ "LinkMngr", _ pcFldPath) Set loProcLog = Nothing End If End Sub Sub VbsOpenExcelFile(pcFileName) '========================================================== 'Function Name : VbsOpenExcelFile 'Purpose : Open an Excel file 'Parameters : pcFileName = path to Excel file '========================================================== Dim loExcelApp Dim loProcLog Call VbsOpenWaitMsg() Call VbsShowWaitMsg("Please wait while file opens...") Set loExcelApp = CreateObject("Excel.Application") on error resume next Call loExcelApp.workbooks.Open(pcFileName) If 0 < err.number Then VbsShowErrMsg("Error opening file !!!" & _ "

" & err.Description) Set loExcelApp = Nothing Else goWaitMsg.close loExcelApp.Visible = true End If on error resume next Set loProcLog = CreateObject("ProcessLog.Scriptlet") If err.number = 0 Then loProcLog.DSN = "ProcessLog" Call loProcLog.PostMessage("Hyperlink Usage", _ "LinkMngr", _ pcFileName) Set loProcLog = Nothing End If End Sub Sub VbsOpenAccessFile(pcFileName) '========================================================== 'Function Name : VbsOpenAccessFile 'Purpose : Open an Access data base file. 'Parameters : pcFileName = path to Access file '========================================================== Dim loAccessApp Dim loProcLog Call VbsOpenWaitMsg() Call VbsShowWaitMsg("Please wait while data base opens...") on error resume next Set loAccessApp = CreateObject("Access.Application") If 0 < err.number Then VbsShowErrMsg("Error opening data base !!!" & _ "

" & err.Description) Set loAccessApp = Nothing End If on error resume next Call loAccessApp.OpenCurrentDatabase(pcFileName) If 0 < err.number Then VbsShowErrMsg("Error opening data base !!!" & _ "

" & err.Description) Set loAccessApp = Nothing Else goWaitMsg.close loAccessApp.Visible = true End If on error resume next Set loProcLog = CreateObject("ProcessLog.Scriptlet") If err.number = 0 Then loProcLog.DSN = "ProcessLog" Call loProcLog.PostMessage("Hyperlink Usage", _ "LinkMngr", _ pcFileName) Set loProcLog = Nothing End If End Sub Sub RunExcelReport(pcReportPathName,pnThreadID) '========================================================== 'Function Name : RunExcelReport 'Purpose : Open an Excel file report with Macros. 'Parameters : pcReportPathName = path and name of Excel file ' : pnThreadID = session identifier 'Note : Excel file must be accessable to client ' PC through a network path. 'Note : Excel file must have at least 3 worksheets; ' Status, Results and Settings. ' Settings must have 2 named ranges; ' Active and ThreadID. 'Note : Excel file must have an event hooked to ' Worksheet_Activate, for Status worksheet. '========================================================== Dim loExcelApp Call VbsOpenWaitMsg() Call VbsShowWaitMsg("Please wait while file opens...") Set loExcelApp = CreateObject("Excel.Application") on error resume next Call loExcelApp.workbooks.Open(pcReportPathName) If 0 < err.number Then VbsShowErrMsg("Error opening file !!!"& _ "

" & err.Description) Set loExcelApp = Nothing Else goWaitMsg.close loExcelApp.workbooks(1).Worksheets("Settings").Range("Active").Value = 1 loExcelApp.workbooks(1).Worksheets("Settings").Range("ThreadID").Value = pnThreadID loExcelApp.Visible = true Call loExcelApp.workbooks(1).Worksheets("Settings").Activate Call loExcelApp.workbooks(1).Worksheets("Status").Activate End If End Sub Sub RunViewGenerator(pcReportPathName,pnThreadID) '========================================================== 'Function Name : RunViewGenerator 'Purpose : Open an Excel file report with Macros. 'Parameters : pcReportPathName = path and name of Excel file ' : pnThreadID = session identifier 'Note : Excel file must be accessable to client ' PC through a network path. 'Note : Excel file must have at least 3 worksheets; ' Status, Results and Settings. ' Settings must have these named ranges; ' Active, PrevWidth, PrevHeight, ThreadID. 'Note : Excel file must have an event hooked to ' Worksheet_Activate, for Status worksheet. '========================================================== Dim loExcelApp Dim lnPrevWidth Dim lnPrevHeight Call VbsOpenWaitMsg() Call VbsShowWaitMsg("Please wait while file opens...") Set loExcelApp = CreateObject("Excel.Application") on error resume next Call loExcelApp.workbooks.Open(pcReportPathName) If 0 < err.number Then VbsShowErrMsg("Error opening file !!!"& _ "

" & err.Description) Set loExcelApp = Nothing Else goWaitMsg.close 'lnPrevWidth = loExcelApp.Width 'lnPrevHeight = loExcelApp.Height 'lbPrevStandard = loExcelApp.CommandBars("Standard").Visible 'lbPrevFormatting = loExcelApp.CommandBars("Formatting").Visible loExcelApp.workbooks(1).Worksheets("Settings").Range("Active").Value = 1 'loExcelApp.workbooks(1).Worksheets("Settings").Range("PrevWidth").Value = lnPrevWidth 'loExcelApp.workbooks(1).Worksheets("Settings").Range("PrevHeight").Value = lnPrevHeight loExcelApp.workbooks(1).Worksheets("Settings").Range("ThreadID").Value = pnThreadID 'loExcelApp.Width = 400 'loExcelApp.Height = 350 'loExcelApp.CommandBars("Standard").Visible = False 'loExcelApp.CommandBars("Formatting").Visible = False loExcelApp.Visible = true Call loExcelApp.workbooks(1).Worksheets("Settings").Activate Call loExcelApp.workbooks(1).Worksheets("Status").Activate End If End Sub Function CheckDistributedProcessing() '========================================================== 'Function Name : CheckDistributedProcessing 'Purpose : See if client PC is configured for distributed ' processing 'Returns : True if PC is configured, False if not. '========================================================== Dim loXmlConfigFile Dim loMsViewMngrNodeList Dim loMsViewMngrNode Dim lcDistributedProcessing Dim lbResult lbResult = False Set loXmlConfigFile = CreateObject("Microsoft.XMLDOM") loXmlConfigFile.Load "C:\SgIntranetConfig\Config.xml" Set loMsViewMngrNodeList = loXmlConfigFile.selectNodes("Config/MsViewMngr") For Each loMsViewMngrNode In loMsViewMngrNodeList lcDistributedProcessing = loMsViewMngrNode.getAttribute("DistributedProcessing") If Not IsNull(lcDistributedProcessing) Then If lcDistributedProcessing = "yes" Then lbResult = True End If End If Next CheckDistributedProcessing = lbResult End Function Function CheckWscDistrProcessing() '========================================================== 'Function Name : CheckWscDistrProcessing 'Purpose : See if client PC is configured for WSC distributed ' processing 'Returns : True if PC is configured, False if not. '========================================================== Dim loXmlConfigFile Dim loMsViewMngrNodeList Dim loMsViewMngrNode Dim lcWscDistrProcessing Dim lbResult lbResult = False Set loXmlConfigFile = CreateObject("Microsoft.XMLDOM") loXmlConfigFile.Load "C:\SgIntranetConfig\Config.xml" Set loMsViewMngrNodeList = loXmlConfigFile.selectNodes("Config/MsViewMngr") For Each loMsViewMngrNode In loMsViewMngrNodeList lcWscDistrProcessing = loMsViewMngrNode.getAttribute("WscDistrProcessing") If Not IsNull(lcWscDistrProcessing) Then If lcWscDistrProcessing = "yes" Then lbResult = True End If End If Next CheckWscDistrProcessing = lbResult End Function Function GetCol(pnColSeq) '========================================================== 'Function Name : GetCol 'Purpose : Convert column number to column letter 'Parameters : pnColSeq = Excel column number 'Returns : Corresponding column letter. '========================================================== Dim lcCol If pnColSeq = 1 Then lcCol = "A" ElseIf pnColSeq = 2 Then lcCol = "B" ElseIf pnColSeq = 3 Then lcCol = "C" ElseIf pnColSeq = 4 Then lcCol = "D" ElseIf pnColSeq = 5 Then lcCol = "E" ElseIf pnColSeq = 6 Then lcCol = "F" ElseIf pnColSeq = 7 Then lcCol = "G" ElseIf pnColSeq = 8 Then lcCol = "H" ElseIf pnColSeq = 9 Then lcCol = "I" ElseIf pnColSeq = 10 Then lcCol = "J" ElseIf pnColSeq = 11 Then lcCol = "K" ElseIf pnColSeq = 12 Then lcCol = "L" ElseIf pnColSeq = 13 Then lcCol = "M" ElseIf pnColSeq = 14 Then lcCol = "N" ElseIf pnColSeq = 15 Then lcCol = "O" ElseIf pnColSeq = 16 Then lcCol = "P" ElseIf pnColSeq = 17 Then lcCol = "Q" ElseIf pnColSeq = 18 Then lcCol = "R" ElseIf pnColSeq = 19 Then lcCol = "S" ElseIf pnColSeq = 20 Then lcCol = "T" ElseIf pnColSeq = 21 Then lcCol = "U" ElseIf pnColSeq = 22 Then lcCol = "V" ElseIf pnColSeq = 23 Then lcCol = "W" ElseIf pnColSeq = 24 Then lcCol = "X" ElseIf pnColSeq = 25 Then lcCol = "Y" ElseIf pnColSeq = 26 Then lcCol = "Z" ElseIf pnColSeq = 27 Then lcCol = "AA" ElseIf pnColSeq = 28 Then lcCol = "AB" ElseIf pnColSeq = 29 Then lcCol = "AC" ElseIf pnColSeq = 30 Then lcCol = "AD" ElseIf pnColSeq = 31 Then lcCol = "AE" ElseIf pnColSeq = 32 Then lcCol = "AF" ElseIf pnColSeq = 33 Then lcCol = "AG" ElseIf pnColSeq = 34 Then lcCol = "AH" ElseIf pnColSeq = 35 Then lcCol = "AI" ElseIf pnColSeq = 36 Then lcCol = "AJ" ElseIf pnColSeq = 37 Then lcCol = "AK" ElseIf pnColSeq = 38 Then lcCol = "AL" ElseIf pnColSeq = 39 Then lcCol = "AM" ElseIf pnColSeq = 40 Then lcCol = "AN" ElseIf pnColSeq = 41 Then lcCol = "AO" ElseIf pnColSeq = 42 Then lcCol = "AP" ElseIf pnColSeq = 43 Then lcCol = "AQ" ElseIf pnColSeq = 44 Then lcCol = "AR" ElseIf pnColSeq = 45 Then lcCol = "AS" ElseIf pnColSeq = 46 Then lcCol = "AT" ElseIf pnColSeq = 47 Then lcCol = "AU" ElseIf pnColSeq = 48 Then lcCol = "AV" ElseIf pnColSeq = 49 Then lcCol = "AW" ElseIf pnColSeq = 50 Then lcCol = "AX" ElseIf pnColSeq = 51 Then lcCol = "AY" ElseIf pnColSeq = 52 Then lcCol = "AZ" ElseIf pnColSeq = 53 Then lcCol = "BA" ElseIf pnColSeq = 54 Then lcCol = "BB" ElseIf pnColSeq = 55 Then lcCol = "BC" ElseIf pnColSeq = 56 Then lcCol = "BD" ElseIf pnColSeq = 57 Then lcCol = "BE" ElseIf pnColSeq = 58 Then lcCol = "BF" ElseIf pnColSeq = 59 Then lcCol = "BG" ElseIf pnColSeq = 60 Then lcCol = "BH" End If GetCol = lcCol End Function