'**************************************************************************
'*
'* Script : Autorunrpt.vbs
'*
'*
'**************************************************************************
'* Revision History
'*
'* V1.0.0 Created By James Bischoff
'*
'**************************************************************************
'**************************************************************************
'* Require variable declaration
'**************************************************************************
Option Explicit
'**************************************************************************
'* Uncomment the following to start debugger
'**************************************************************************
'stop
'**************************************************************************
'* Application Constants
'**************************************************************************
Const mcintDebug = 0
Const mcstrAppname = "AutoRunRpt"
Const mcstrLimitFile = "d:\SQRReports\Generic\limits.inc"
Const mcstrMessengerErrorFile = "\\dcrprcdev1\processed\Error\AutoRunRpt.txt"
Const mcstrMessengerDebugFile = "\\dcrprcdev1\processed\Message\AutoRunRpt.txt"
Const mcstrSQRDir = "d:\SQRReports"
Const mcstrConnect = "process_data/process_data@ECL1"
Const mcblnSkipPrint = False
Const mcblnTestPrint = True
Const mcstrTestPrinter = "adm200a"
Const mcstrAlkPrinter = "ccbalkal"
Const mcstrBldPrinter = "bldal"
Const mcstrCcrPrinter = "ccrbl"
Const mcstrDesPrinter = "desal"
Const mcstrHycPrinter = "ccbhycal"
'**************************************************************************
'* WScript Constants
'**************************************************************************
Const SW_HIDE = 0 'wShowWindow Element in STARTUPINFO
'**************************************************************************
'* Error Constants
'**************************************************************************
Const mclngSuccess = 0
Const mclngFailure = 1
'**************************************************************************
'* Global Variables
'**************************************************************************
Dim mobjLocalMessenger
Dim mstrDate
Dim mstrDayDate
Dim mstrHourDate
Dim mstrCurrentDate
Dim mintHour
Dim mintMinute
Dim mintDayOfWeek
Dim mstrPreviousDayOfWeek
'**************************************************************************
'* WScript Execution Check
'**************************************************************************
If IsObject(WScript) Then 'If running under WScript
OnLoad
OnTimer
OnUnLoad
End If
'**************************************************************************
'* Function : OnLoad
'* Purpose : Instantiate all heavy duty objects required by this script.
'* The objects must be assigned to global variables.
'**************************************************************************
Sub OnLoad()
On Error Resume Next
Set mobjLocalMessenger = CreateObject("BayCore.Debug")
SendDebug "OnLoad Start"
mobjLocalMessenger.SetErrorFile mcstrMessengerErrorFile
mobjLocalMessenger.SetMessageFile mcstrMessengerDebugFile
SendDebug "OnLoad End"
End Sub
'**************************************************************************
'* Function : OnUnLoad
'* Purpose : Destroy all heavy duty global objects created by OnLoad.
'**************************************************************************
Sub OnUnload()
On Error Resume Next
SendDebug "OnUnload Start"
SendDebug "OnUnload End"
Set mobjLocalMessenger = Nothing
End Sub
'**************************************************************************
'* Function : OnTimer
'* Purpose : The main procedure.
'**************************************************************************
Sub OnTimer()
On Error Resume Next
Dim dtmCurrentTime
Dim intMinutes
Dim strTempDate
SendDebug "OnTimer Start"
'Change this date to run for a specific date as follows
mstrDate = "06/22/1999 00:30:00"
'mstrDate = cStr(Now())
FormatDateDay
FormatDateHour
FormatDateCurrent
If mintMinute < 13 Then
mintMinute = 0
ElseIf mintMinute < 28 Then
mintMinute = 15
ElseIf mintMinute < 43 Then
mintMinute = 30
Else
mintMinute = 45
End If
Select Case mintDayOfWeek
Case 1 mstrPreviousDayOfWeek = "SAT"
Case 2 mstrPreviousDayOfWeek = "SUN"
Case 3 mstrPreviousDayOfWeek = "MON"
Case 4 mstrPreviousDayOfWeek = "TUE"
Case 5 mstrPreviousDayOfWeek = "WED"
Case 6 mstrPreviousDayOfWeek = "THU"
Case 7 mstrPreviousDayOfWeek = "FRI"
End Select
If mintMinute = 0 Then
RunHourlyReports
End If
If mintHour = 1 and mintMinute = 45 Then
RunHour8Reports
End If
If mintHour = 8 and mintMinute = 0 Then
RunHour8Reports
End If
If mintHour = 0 and mintMinute = 0 Then
RunHour0Reports
End If
If (mintHour = 5 or mintHour = 13 or mintHour = 21) and mintMinute = 30 Then
RunShiftReports
End If
If mintHour = 0 and mintMinute = 30 Then
RunPumpSheetReportsYesterday
End If
SendDebug "OnTimer End"
End Sub
'**************************************************************************
'* Function : RunHourlyReports
'* Purpose : Run Hourly Jobs
'**************************************************************************
Function RunHourlyReports()
On Error Resume Next
SendDebug "RunHourlyReports Start"
RunAndPrintReport _
"BLD", _
"40levtmp", _
"40levtmp", _
mstrHourDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\bld\40levtmp.rpt", _
"HOURLY", _
"", _
mcstrBldPrinter, _
"", _
"", _
"", _
1
RunAndPrintReport _
"BLD", _
"40acttnk", _
"40acttnk", _
mstrHourDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\bld\active_tank.rpt", _
"HOURLY", _
"", _
mcstrBldPrinter, _
"", _
"", _
"", _
1
SendDebug "RunHourlyReports End"
End Function
'**************************************************************************
'* Function : RunHour1Reports
'* Purpose : Run Hourly Jobs
'**************************************************************************
Function RunHour1Reports()
On Error Resume Next
SendDebug "RunHour1Reports Start"
RunAndPrintReport _
"SGS", _
"misrpt", _
"misrpt", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\sgs\sgs_" & mstrPreviousDayOfWeek & ".mis", _
"DAILY", _
"", _
"", _
"", _
"", _
"", _
1
SendDebug "RunHour1Reports End"
End Function
'**************************************************************************
'* Function : RunHour8Reports
'* Purpose : Run Hourly Jobs
'**************************************************************************
Function RunHour8Reports()
On Error Resume Next
SendDebug "RunHour8Reports Start"
RunAndPrintReport _
"ETR", _
"loops", _
"43cc4sh", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\etr\43cc4sh.rpt", _
"HOURLY", _
"", _
mcstrDesPrinter, _
"", _
"", _
"", _
1
RunAndPrintReport _
"ETR", _
"loops", _
"43cutil", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\etr\43cutil.rpt", _
"HOURLY", _
"", _
mcstrDesPrinter, _
"", _
"", _
"", _
1
SendDebug "RunHour8Reports End"
End Function
'**************************************************************************
'* Function : RunHour0Reports
'* Purpose : Run Hourly Jobs
'**************************************************************************
Function RunHour0Reports()
On Error Resume Next
Dim objFileSystem
SendDebug "RunHour0Reports Start"
Set objFileSystem = CreateObject("File.System")
RunAndPrintReport _
"CCR", _
"42mis", _
"42mis", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\ccr\ccr_" & mstrPreviousDayOfWeek & ".mis", _
"HOURLY", _
"", _
mcstrCcrPrinter, _
"", _
"", _
"", _
1
RunAndPrintReport _
"BLD", _
"acctlog", _
"40acct", _
mstrDayDate, _
"00/00/00,00:00:00", _
"f:\outgoing\reports\bld\tgs_" & mstrPreviousDayOfWeek & ".mis", _
"HOURLY", _
"", _
"", _
"", _
"", _
"", _
1
RunAndPrintReport _
"ALK", _
"apply_gc", _
"applygc", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\alk\agc_" & mstrPreviousDayOfWeek & ".chm", _
"DAILY", _
"", _
"", _
"", _
"", _
"", _
1
RunAndPrintReport _
"ALK", _
"267chrom", _
"267chrom", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\alk\alk_" & mstrPreviousDayOfWeek & ".chm", _
"DAILY", _
"", _
"", _
"", _
"", _
"", _
1
RunAndPrintReport _
"ALK", _
"267chrom", _
"267chrom", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\alk\midnight.alk", _
"DAILY", _
"", _
"", _
"", _
"", _
"", _
1
RunAndPrintReport _
"ALK", _
"267mis", _
"267mis", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\alk\alk_" & mstrPreviousDayOfWeek & ".mis", _
"HOURLY", _
"", _
"", _
"", _
"", _
"", _
1
objFileSystem.AppendTextFile _
"f:\outgoing\reports\alk\midnight.alk", _
"f:\outgoing\reports\alk\alk_" & mstrPreviousDayOfWeek & ".mis"
RunAndPrintReport _
"ALK", _
"40tanks", _
"40tanks", _
mstrCurrentDate, _
"00/00/00,00:00:00", _
"f:\outgoing\reports\alk\40tanks.rpt", _
"CURRENT", _
"", _
"", _
"", _
"", _
"", _
1
objFileSystem.AppendTextFile _
"f:\outgoing\reports\alk\midnight.alk", _
"f:\outgoing\reports\alk\40tanks.rpt"
RunAndPrintReport _
"ALK", _
"267ops", _
"267ops", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\alk\267ops.rpt", _
"HOURLY", _
"", _
"", _
"", _
"", _
"", _
1
objFileSystem.AppendTextFile _
"f:\outgoing\reports\alk\midnight.alk", _
"f:\outgoing\reports\alk\267ops.rpt"
RunAndPrintReport _
"ALK", _
"267gcsum", _
"267gcsum", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\alk\267gcsum.rpt", _
"HOURLY", _
"", _
"", _
"", _
"", _
"", _
1
objFileSystem.AppendTextFile _
"f:\outgoing\reports\alk\midnight.alk", _
"f:\outgoing\reports\alk\267gcsum.rpt"
RunAndPrintReport _
"ALK", _
"267nsr", _
"267nsr", _
mstrCurrentDate, _
"00/00/00,00:00:00", _
"f:\outgoing\reports\alk\267nsr.rpt", _
"CURRENT", _
"", _
"", _
"", _
"", _
"", _
1
objFileSystem.AppendTextFile _
"f:\outgoing\reports\alk\midnight.alk", _
"f:\outgoing\reports\alk\267nsr.rpt"
RunAndPrintReport _
"ALK", _
"labsummary", _
"26labsum", _
mstrCurrentDate, _
"00/00/00,00:00:00", _
"f:\outgoing\reports\alk\26labsum.rpt", _
"CURRENT", _
"", _
"", _
"", _
"", _
"", _
1
objFileSystem.AppendTextFile _
"f:\outgoing\reports\alk\midnight.alk", _
"f:\outgoing\reports\alk\26labsum.rpt"
RunAndPrintReport _
"ALK", _
"labsummary", _
"27labsum", _
mstrCurrentDate, _
"00/00/00,00:00:00", _
"f:\outgoing\reports\alk\27labsum.rpt", _
"CURRENT", _
"", _
"", _
"", _
"", _
"", _
1
objFileSystem.AppendTextFile _
"f:\outgoing\reports\alk\midnight.alk", _
"f:\outgoing\reports\alk\27labsum.rpt"
If PrintReport( _
"f:\outgoing\reports\alk\midnight.alk", _
mcstrAlkPrinter, _
"", _
"", _
"", _
1) = mclngFailure Then
SendError "RunHour0Reports Error [PrintReport Failed]"
End If
RunAndPrintReport _
"FCC", _
"234mis", _
"234mis", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\crd\nac_" & mstrPreviousDayOfWeek & ".mis", _
"HOURLY", _
"", _
"", _
"", _
"", _
"", _
1
RunAndPrintReport _
"CRD", _
"21mis", _
"21mis", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\crd\21mis.rpt", _
"HOURLY", _
"", _
"", _
"", _
"", _
"", _
1
objFileSystem.AppendTextFile _
"f:\outgoing\reports\crd\nac_" & mstrPreviousDayOfWeek & ".mis", _
"f:\outgoing\reports\crd\21mis.rpt"
RunAndPrintReport _
"COK", _
"22mis", _
"22mis", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\crd\22mis.rpt", _
"HOURLY", _
"", _
"", _
"", _
"", _
"", _
1
objFileSystem.AppendTextFile _
"f:\outgoing\reports\crd\nac_" & mstrPreviousDayOfWeek & ".mis", _
"f:\outgoing\reports\crd\22mis.rpt"
RunAndPrintReport _
"MEH", _
"41tanks", _
"41tanks", _
mstrDayDate, _
"00/00/00,01:00:00", _
"f:\outgoing\reports\meh\meh_" & mstrPreviousDayOfWeek & ".mis", _
"HOURLY", _
"", _
"", _
"", _
"", _
"", _
1
RunAndPrintReport _
"MEH", _
"41apply", _
"41apply", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\meh\41apply.rpt", _
"HOURLY", _
"", _
"", _
"", _
"", _
"", _
1
objFileSystem.AppendTextFile _
"f:\outgoing\reports\meh\meh_" & mstrPreviousDayOfWeek & ".mis", _
"f:\outgoing\reports\meh\41apply.rpt"
RunAndPrintReport _
"MEH", _
"41spc", _
"41spc", _
mstrDayDate, _
"00/00/00,01:00:00", _
"f:\outgoing\reports\meh\41spc.rpt", _
"HOURLY", _
"", _
"", _
"", _
"", _
"", _
1
objFileSystem.AppendTextFile _
"f:\outgoing\reports\meh\meh_" & mstrPreviousDayOfWeek & ".mis", _
"f:\outgoing\reports\meh\41spc.rpt"
RunAndPrintReport _
"DES", _
"29mis", _
"29mis", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\des\des_" & mstrPreviousDayOfWeek & ".mis", _
"HOURLY", _
"", _
mcstrDesPrinter, _
"", _
"", _
"", _
1
RunAndPrintReport _
"REF", _
"25apply", _
"25apply", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\ref\ref_" & mstrPreviousDayOfWeek & ".mis", _
"HOURLY", _
"", _
"", _
"", _
"", _
"", _
1
RunAndPrintReport _
"REF", _
"25applyt", _
"25applyt", _
mstrDayDate, _
"00/00/00,01:00:00", _
"f:\outgoing\reports\ref\ref_" & mstrPreviousDayOfWeek & ".tnk", _
"HOURLY", _
"", _
"", _
"", _
"", _
"", _
1
RunAndPrintReport _
"ETR", _
"43mis", _
"43mis", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\etr\etr_" & mstrPreviousDayOfWeek & ".mis", _
"HOURLY", _
"", _
mcstrDesPrinter, _
"", _
"", _
"", _
1
RunAndPrintReport _
"HYC", _
"367mis", _
"367mis", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\hyc\hyc_" & mstrPreviousDayOfWeek & ".mis", _
"HOURLY", _
"", _
"", _
"", _
"", _
"", _
1
RunAndPrintReport _
"HYC", _
"367ops", _
"367ops", _
mstrCurrentDate, _
"00/00/00,00:00:00", _
"f:\outgoing\reports\hyc\hyc_" & mstrPreviousDayOfWeek & ".ops", _
"CURRENT", _
"", _
"", _
"", _
"", _
"", _
1
objFileSystem.AppendTextFile _
"f:\outgoing\reports\hyc\hyc_" & mstrPreviousDayOfWeek & ".mis", _
"f:\outgoing\reports\hyc\hyc_" & mstrPreviousDayOfWeek & ".ops"
If PrintReport( _
"f:\outgoing\reports\hyc\hyc_" & mstrPreviousDayOfWeek & ".mis", _
mcstrDesPrinter, _
"", _
"", _
"", _
1) = mclngFailure Then
SendError "RunHour0Reports Error [PrintReport Failed]"
End If
RunAndPrintReport _
"HYC", _
"367mis", _
"367mis", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\hyc\hyc_" & mstrPreviousDayOfWeek & ".mis", _
"HOURLY", _
"", _
"", _
"", _
"", _
"", _
1
RunAndPrintReport _
"HYC", _
"apply_gc", _
"applygc", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\hyc\hyc_" & mstrPreviousDayOfWeek & ".gc", _
"HOURLY", _
"", _
"", _
"", _
"", _
"", _
1
Set objFileSystem = Nothing
SendDebug "RunHour0Reports End"
End Function
'**************************************************************************
'* Function : RunShiftReports
'* Purpose : Run Shift Jobs
'**************************************************************************
Function RunShiftReports()
On Error Resume Next
Dim objFileSystem
SendDebug "RunShiftReports Start"
Set objFileSystem = CreateObject("File.System")
RunAndPrintReport _
"HYC", _
"367nsr", _
"367nsr", _
mstrCurrentDate, _
"00/00/00,00:00:00", _
"f:\outgoing\reports\hyc\hycshift.rpt", _
"CURRENT", _
"", _
"", _
"", _
"", _
"", _
1
RunAndPrintReport _
"HYC", _
"loops_mode", _
"36loops", _
mstrCurrentDate, _
"00/00/00,00:00:00", _
"f:\outgoing\reports\hyc\36loops.rpt", _
"CURRENT", _
"", _
"", _
"", _
"", _
"", _
1
objFileSystem.AppendTextFile _
"f:\outgoing\reports\hyc\hycshift.rpt", _
"f:\outgoing\reports\hyc\36loops.rpt"
RunAndPrintReport _
"HYC", _
"loops_mode", _
"37loops", _
mstrCurrentDate, _
"00/00/00,00:00:00", _
"f:\outgoing\reports\hyc\37loops.rpt", _
"CURRENT", _
"", _
"", _
"", _
"", _
"", _
1
objFileSystem.AppendTextFile _
"f:\outgoing\reports\hyc\hycshift.rpt", _
"f:\outgoing\reports\hyc\37loops.rpt"
RunAndPrintReport _
"HYC", _
"labsummary", _
"36labsum", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\hyc\36labsum.rpt", _
"HOURLY", _
"", _
"", _
"", _
"", _
"", _
1
objFileSystem.AppendTextFile _
"f:\outgoing\reports\hyc\hycshift.rpt", _
"f:\outgoing\reports\hyc\36labsum.rpt"
RunAndPrintReport _
"HYC", _
"labsummary", _
"37labsum", _
mstrDayDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\hyc\37labsum.rpt", _
"HOURLY", _
"", _
"", _
"", _
"", _
"", _
1
objFileSystem.AppendTextFile _
"f:\outgoing\reports\hyc\hycshift.rpt", _
"f:\outgoing\reports\hyc\37labsum.rpt"
If PrintReport( _
"f:\outgoing\reports\hyc\hycshift.rpt", _
mcstrHycPrinter, _
"", _
"", _
"", _
1) = mclngFailure Then
SendError "RunHour0Reports Error [PrintReport Failed]"
End If
Set objFileSystem = Nothing
SendDebug "RunHour0Reports End"
End Function
'**************************************************************************
'* Function : RunPumpSheetReports
'* Purpose : Run Pump Sheet Jobs
'**************************************************************************
Function RunPumpSheetReports()
On Error Resume Next
Dim objFileSystem
SendDebug "RunPumpSheetReports Start"
Set objFileSystem = CreateObject("File.System")
RunAndPrintReport _
"BLD", _
"psallhdr", _
"psallhdr", _
mstrPumpDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\bld\pumpsheet.rpt", _
"DAILY", _
"process_data/process_data@YLD0.dcp.starent.com", _
"", _
"", _
"", _
"", _
1
RunAndPrintReport _
"BLD", _
"pscruchg", _
"pscruchg", _
mstrPumpDate, _
"00/01/00,00:00:00", _
"f:\outgoing\reports\bld\pscruchg.rpt", _
"DAILY", _
"process_data/process_data@YLD0.dcp.starent.com", _
"", _
"", _
"", _
"", _
1
objFileSystem.AppendTextFile _
"f:\outgoing\reports\bld\pumpsheet.rpt", _
"f:\outgoing\reports\bld\pscruchg.rpt"
If PrintReport( _
"f:\outgoing\reports\bld\pumpsheet.rpt", _
mcstrBldPrinter, _
"", _
"", _
"", _
1) = mclngFailure Then
SendError "RunPumpSheetReportsYesterday Error [PrintReport Failed]"
End If
Set objFileSystem = Nothing
SendDebug "RunPumpSheetReports End"
End Function
'**************************************************************************
'* Function : RunAndPrintReport
'* Purpose : Run and Print an SQR Report.
'**************************************************************************
Function RunAndPrintReport( _
strUnitName, _
strSQRProgram, _
strGroupSuffix, _
strEndDate, _
strDeltaDate, _
strOutputFile, _
strDataType, _
strConnect, _
strPrinter, _
strOrientation, _
strFontName, _
strFontSize, _
lngCopies)
On Error Resume Next
Dim lngStatus
SendDebug "RunAndPrintReport Start"
RunAndPrintReport = mclngSuccess
If RunReport( _
strUnitName, _
strSQRProgram, _
strGroupSuffix, _
strEndDate, _
strDeltaDate, _
strOutputFile, _
strDataType, _
strConnect, _
lngStatus) = mclngFailure Then
SendError "RunAndPrintReport Error [RunReport Failed]"
RunAndPrintReport = mclngFailure
Exit Function
End If
If strPrinter <> "" Then
If PrintReport( _
strOutputFile, _
strPrinter, _
strOrientation, _
strFontName, _
strFontSize, _
lngCopies) = mclngFailure Then
SendError "RunAndPrintReport Error [PrintReport Failed]"
RunAndPrintReport = mclngFailure
Exit Function
End If
End If
SendDebug "RunAndPrintReport End"
End Function
'**************************************************************************
'* Function : PrintReport
'* Purpose : Print an SQR Report.
'**************************************************************************
Function PrintReport( _
strFile, _
strPrinter, _
strOrientation, _
strFontName, _
strFontSize, _
lngCopies)
On Error Resume Next
Dim objPrtFile
Dim lngOrientation
Dim lngFontSize
Dim lngCopy
SendDebug "PrintReport Start"
PrintReport = mclngSuccess
If strPrinter = "" Then
strPrinter = "ADMlibap"
End If
If strOrientation = "Landscape" Then
lngOrientation = 2
Else
lngOrientation = 1
End If
If strFontName = "" Then
strFontName = "Courier New"
End If
If strFontSize = "" Then
lngFontSize = 10
Else
lngFontSize = cLng(strFontSize)
End If
Set objPrtFile = CreateObject("Prt.File")
objPrtFile.lngDebug = cLng(mcintDebug)
SendDebug "PrintReport strFile [" & strFile & "]"
SendDebug "PrintReport strPrinter [" & strPrinter & "]"
SendDebug "PrintReport lngOrientation [" & cStr(lngOrientation) & "]"
SendDebug "PrintReport strFontName [" & strFontName & "]"
SendDebug "PrintReport lngFontSize [" & cStr(lngFontSize) & "]"
If mcblnSkipPrint Then
SendDebug "PrintReport Skip"
Exit Function
End If
If mcblnTestPrint Then
strPrinter = mcstrTestPrinter
End If
For lngCopy = 1 to lngCopies
If objPrtFile.PrintFile( _
strFile, _
strPrinter, _
lngOrientation, _
strFontName, _
lngFontSize) = False Then
SendError "PrintReport Error [objPrtFile Failed]"
PrintReport = mclngFailure
Exit Function
End If
Next
Set objPrtFile = Nothing
SendDebug "PrintReport End"
End Function
'**************************************************************************
'* Function : RunReport
'* Purpose : Run an SQR Report.
'**************************************************************************
Function RunReport( _
strUnitName, _
strSQRProgram, _
strGroupSuffix, _
strEndDate, _
strDeltaDate, _
strOutputFile, _
strDataType, _
strConnect, _
lngStatus)
On Error Resume Next
Dim strCommand
Dim objWshShell
Dim strDebug
SendDebug "RunReport Start"
RunReport = mclngSuccess
lngStatus = mclngSuccess
SendDebug "RunReport strUnitName [" & strUnitName & "]"
If strConnect = "" Then
strConnect = mcstrConnect
End If
If mcintDebug > 0 Then
strDebug = " -b "
Else
strDebug = " "
End If
strCommand = "cscript.exe d:\scripts\runrpt.wsh" & _
" -x " & strUnitName & _
" -t " & strSQRProgram & _
" -n " & strGroupSuffix & _
" -e " & strEndDate & _
" -d " & strDeltaDate & _
" -o " & strOutputFile & _
" -T " & strDataType & _
" -s " & mcstrSQRDir & "\DCR\" & strUnitName & "\" & _
" -u AUTOEXEC -O TXT -r Y -c " & strConnect & strDebug
SendMessage "Execute [" & cStr(strCommand) & "]"
Set objWshShell = CreateObject("WScript.Shell")
lngStatus = objWshShell.Run(strCommand, SW_HIDE, True)
If Err.Number <> 0 Then
lngStatus = 1
RunReport = mclngFailure
SendError "Execute Error [Could not start VBScript]"
Else
If lngStatus <> 0 Then
RunReport = mclngFailure
SendError "Execute Error [Error Details In RunRpt.Err]"
End if
End if
Set objWshShell = Nothing
SendMessage "Execute Return Status [" & cStr(lngStatus) & "]"
SendDebug "RunReport End"
End Function
'**************************************************************************
'* Function : FormatDateDay
'* Purpose : Format a date as MM/DD/YYYY 00:00:00.
'**************************************************************************
Function FormatDateDay()
On Error Resume Next
Dim strDate
Dim strMonth
Dim strDay
Dim strYear
FormatDate = mclngSuccess
strDate = mstrDate
SendDebug "FormatDateDay Start [" & strDate & "]"
If ZeroFill(DatePart("m", strDate), 2, strMonth) = mclngFailure Then
FormatDateDay = mclngFailure
Exit Function
End If
If ZeroFill(Datepart("d", strDate), 2, strDay) = mclngFailure Then
FormatDateDay = mclngFailure
Exit Function
End If
If ZeroFill(DatePart("yyyy", strDate), 4, strYear) = mclngFailure Then
FormatDateDay = mclngFailure
Exit Function
End If
mstrDayDate = strMonth & "/" & _
strDay & "/" & _
Right(strYear,2) & ",00:00:00"
SendDebug "FormatDateDay End [" & mstrDayDate & "]"
End Function
'**************************************************************************
'* Function : FormatDateHour
'* Purpose : Format a date as MM/DD/YYYY HH24:00:00.
'**************************************************************************
Function FormatDateHour()
On Error Resume Next
Dim strDate
Dim strMonth
Dim strDay
Dim strYear
Dim strHour
FormatDate = mclngSuccess
strDate = mstrDate
SendDebug "FormatDateHour Start [" & strDate & "]"
If ZeroFill(DatePart("m", strDate), 2, strMonth) = mclngFailure Then
FormatDateHour = mclngFailure
Exit Function
End If
If ZeroFill(Datepart("d", strDate), 2, strDay) = mclngFailure Then
FormatDateHour = mclngFailure
Exit Function
End If
If ZeroFill(DatePart("yyyy", strDate), 4, strYear) = mclngFailure Then
FormatDateHour = mclngFailure
Exit Function
End If
If ZeroFill(DatePart("h", strDate), 2, strHour) = mclngFailure Then
FormatDateHour = mclngFailure
Exit Function
End If
mstrHourDate = strMonth & "/" & _
strDay & "/" & _
Right(strYear,2) & "," & _
strHour & ":00:00"
SendDebug "FormatDateHour End [" & mstrHourDate & "]"
End Function
'**************************************************************************
'* Function : FormatDateCurrent
'* Purpose : Format a date as MM/DD/YYYY HH24:MI:SS.
'**************************************************************************
Function FormatDateCurrent()
On Error Resume Next
Dim strDate
Dim strMonth
Dim strDay
Dim strYear
Dim strHour
Dim strMinute
Dim strSecond
FormatDate = mclngSuccess
strDate = mstrDate
SendDebug "FormatDateCurrent Start [" & strDate & "]"
If ZeroFill(DatePart("m", strDate), 2, strMonth) = mclngFailure Then
FormatDateCurrent = mclngFailure
Exit Function
End If
If ZeroFill(Datepart("d", strDate), 2, strDay) = mclngFailure Then
FormatDateCurrent = mclngFailure
Exit Function
End If
If ZeroFill(DatePart("yyyy", strDate), 4, strYear) = mclngFailure Then
FormatDateCurrent = mclngFailure
Exit Function
End If
If ZeroFill(DatePart("h", strDate), 2, strHour) = mclngFailure Then
FormatDateCurrent = mclngFailure
Exit Function
End If
If ZeroFill(DatePart("n", strDate), 2, strMinute) = mclngFailure Then
FormatDateCurrent = mclngFailure
Exit Function
End If
If ZeroFill(DatePart("s", strDate), 2, strSecond) = mclngFailure Then
FormatDateCurrent = mclngFailure
Exit Function
End If
mstrCurrentDate = strMonth & "/" & _
strDay & "/" & _
Right(strYear,2) & "," & _
strHour & ":" & _
strMinute & ":" & _
strSecond
mintHour = cint(strHour)
mintMinute = cint(strMinute)
mintDayOfWeek = cint(DatePart("w", strDate))
SendDebug "FormatDateCurrent End [" & mstrCurrentDate & "]"
End Function
'**************************************************************************
'* Function : ZeroFill
'* Purpose : Zero fill a number.
'**************************************************************************
Function ZeroFill(intNumber, intMinLength, strZeroFilled)
On Error Resume Next
Dim intCnt
SendDebug "ZeroFill Start [" & cStr(intNumber) & "," & cStr(intMinLength) & "]"
ZeroFill = mclngSuccess
strZeroFilled = cStr(intNumber)
intCnt = 0
Do While intCnt < (intMinLength - Len(intNumber))
strZeroFilled = "0" & strZeroFilled
intCnt = intCnt + 1
Loop
If Err.Number Then
SendError "ZeroFill Error [" & Err.Description & "]"
ZeroFill = mclngFailure
Exit Function
End If
SendDebug "ZeroFill End [" & strZeroFilled & "]"
End Function
'**************************************************************************
'* Function : SendDebug, SendError, SendMessage
'* Purpose : Output messages using the LocalMessenger object.
'*
'* SendLocalMessage takes the following string parameters:
'*
'* Type = Error, Warning, Message, Debug
'* Channel = File, Debug, Event, All
'* AppName = Application Name
'* Message = The Message
'*
'**************************************************************************
'**************************************************************************
'* Debug Only
'**************************************************************************
Sub SendDebug(strMessage)
On Error Resume Next
If mcintDebug Then
mobjLocalMessenger.SendLocalMessage "Debug", _
"Debug", _
mcstrAppname, _
strMessage
End If
If mcintDebug >= 10 Then
mobjLocalMessenger.SendLocalMessage "Message", _
"File", _
mcstrAppname, _
strMessage
End If
End Sub
'**************************************************************************
'* Debug and File
'**************************************************************************
Sub SendMessage(strMessage)
On Error Resume Next
mobjLocalMessenger.SendLocalMessage "Message", _
"File", _
mcstrAppname, _
strMessage
End Sub
'**************************************************************************
'* Debug, File, and Event Log
'**************************************************************************
Sub SendError(strMessage)
On Error Resume Next
mobjLocalMessenger.SendLocalMessage "Error", _
"All", _
mcstrAppname, _
strMessage
End Sub
|
