December 16, 2009
This post is adapted from a small part of a presentation I gave a couple months ago. The original code sample integrated into an ERP system to display an employee’s running attendance record for the last 6 or 12 months in graphical form, output to an Internet Explorer window.
First, we need sample “attendance” data in a table:
CREATE TABLE EMPLOYEE_RECORD_TEST AS SELECT DECODE(TRUNC(DBMS_RANDOM.VALUE(0,5)), 0,'MIKE', 1,'ROB', 2,'SAM', 3,'JOE', 4,'ERIC') EMPLOYEE_ID, TRUNC(SYSDATE)-ROUND(DBMS_RANDOM.VALUE(0,1000)) SHIFT_DATE, DECODE(TRUNC(DBMS_RANDOM.VALUE(0,10)), 0,'VAC', 1,'HOL', 2,'BEREAVE', 3,'JURY', 4,'ABS', 5,'EXCUSE', 6,'MIL', 'OTHER') INDIRECT_ID FROM DUAL CONNECT BY LEVEL<=1000;
The above created a table with 1,000 rows that picked one of five employees at random for each row, specifying a random date between today and 999 days ago, with one of eight random identifiers for the date. The data in the table will look something like this:
SELECT * FROM EMPLOYEE_RECORD_TEST WHERE ROWNUM<=10; EMPLOYEE_ID SHIFT_DAT INDIRECT_ID ----------- --------- ----------- MIKE 03-SEP-08 OTHER MIKE 26-JUL-09 HOL MIKE 27-MAY-09 EXCUSE ERIC 27-JUL-08 OTHER ERIC 02-NOV-07 VAC ROB 02-OCT-07 OTHER JOE 26-MAY-08 HOL ERIC 29-JUL-08 ABS ERIC 23-JUL-09 MIL ERIC 14-JUN-07 HOL
Now that we have sample data, let’s see what we are trying to achieve (reduced in size):
As the color-coded output shows, Eric took a vacation day on January 4 and March 8. Eric also was on bereavement leave on February 23 and 24, as well as March 22 and 25. So, how was this output created? A VBS script connected to the Oracle database (using a custom DLL to hide the username and password, and to simplify the process of submitting the SQL statement with bind variables), submitted a query, and then built the web page on the fly.
Dim varDateStart
Dim varDateEnd
Dim varDateMonthStart
Dim varDateMonthEnd
Dim intWeekdayStart
Dim intShiftDay
Dim i
Dim intRow
Dim intCol
'The color constants
Dim lngVacationBackColor
Dim lngHolidayBackColor
Dim lngBereavementBackColor
Dim lngJuryDutyBackColor
Dim lngAbsentBackColor
Dim lngExcusedBackColor
Dim lngMilitaryBackColor
Dim lngOtherMonthBackColor
Dim lngDateBackColor(31)
Dim lngDateForeColor(31)
Dim strSQL
Dim snpData
Dim OracleSQL
Dim objIE
Dim objShell
Dim intLastMonth
Dim intOutputMonth
Dim strHTML
Dim strEmployeeID
Dim dteTransactionDate
strEmployeeID = "MIKE"
'strEmployeeID = "ROB"
'strEmployeeID = "SAM"
'strEmployeeID = "JOE"
'strEmployeeID = "ERIC"
'dteTransactionDate = CDate("January 1, 2009") 'Can specify a specific date
dteTransactionDate = Date 'Can specify the current date
'Define the colors to be used to indicate the indirect in the date
'Note that the RGB components must be specified as BGR to be compatible with HTML
lngVacationBackColor = RGB(255, 0, 0)
lngHolidayBackColor = RGB(0, 255, 0)
lngBereavementBackColor = RGB(255, 175, 0)
lngJuryDutyBackColor = RGB(33, 153, 255)
lngAbsentBackColor = RGB(0, 0, 255)
lngExcusedBackColor = RGB(0, 255, 255)
lngMilitaryBackColor = RGB(255, 0, 150)
lngOtherMonthBackColor = RGB(75, 75, 100)
Set OracleSQL = CreateObject("VMDBOracle.SQLProcessor")
Set snpData = CreateObject("ADODB.Recordset")
'Specify the start of the month based on the current transaction date - set it back to the first day of the month
varDateStart = DateAdd("m", -11, DateSerial(DatePart("yyyy", dteTransactionDate), DatePart("m", dteTransactionDate), 1))
'Finding the end of the month is a little more difficult - we add 1 month to the transaction date, find the start of that month, and subtract one day
varDateEnd = DateAdd("d", -1, DateSerial(DatePart("yyyy", DateAdd("m", 1, dteTransactionDate)), DatePart("m", DateAdd("m", 1, dteTransactionDate)), 1))
'Set the starting colors
For i = 1 To 31
lngDateBackColor(i) = RGB(230, 230, 230) 'Off White
lngDateForeColor(i) = RGB(0, 0, 0) 'Black
Next
strSQL = "SELECT" & vbCrLf
strSQL = strSQL & " SHIFT_DATE," & vbCrLf
strSQL = strSQL & " EMPLOYEE_ID," & vbCrLf
strSQL = strSQL & " INDIRECT_ID" & vbCrLf
strSQL = strSQL & "FROM" & vbCrLf
strSQL = strSQL & " EMPLOYEE_RECORD_TEST" & vbCrLf
strSQL = strSQL & "WHERE" & vbCrLf
strSQL = strSQL & " SHIFT_DATE BETWEEN ? AND ?" & vbCrLf
strSQL = strSQL & " AND INDIRECT_ID IS NOT NULL" & vbCrLf
'Specify the start of the month based on the current transaction date - set it back to the first day of the month
OracleSQL.SetParameter varDateStart, "DATE"
'Finding the end of the month is a little more difficult - we add 1 month to the transaction date, find the start of that month, and subtract one day
OracleSQL.SetParameter varDateEnd, "DATE"
If strEmployeeID <> "" Then
strSQL = strSQL & " AND EMPLOYEE_ID= ?" & vbCrLf
OracleSQL.SetParameter strEmployeeID, "VARCHAR"
End If
strSQL = strSQL & "ORDER BY" & vbCrLf
strSQL = strSQL & " SHIFT_DATE," & vbCrLf
strSQL = strSQL & " EMPLOYEE_ID," & vbCrLf
strSQL = strSQL & " INDIRECT_ID DESC"
OracleSQL.Sql = strSQL
Set snpData = OracleSQL.Execute
intOutputMonth = False
strHTML = ""
intRow = 0
'Shadow
strHTML = strHTML & "<div style=""position: absolute; width: 200px; height: 20px;"
strHTML = strHTML & "top: 7px;left: 7;"
strHTML = strHTML & "font-family: Arial; font-size: 18pt; color: #000000;"
strHTML = strHTML & "background-color: #FFFFFF;"">"
strHTML = strHTML & "<b>" & strEmployeeID & "</b></div>" & vbCrLf
strHTML = strHTML & "<div style=""position: absolute; width: 200px; height: 20px;"
strHTML = strHTML & "top: 5px;left: 5;"
strHTML = strHTML & "font-family: Arial; font-size: 18pt; color: #FFFF00;"">"
strHTML = strHTML & "<b>" & strEmployeeID & "</b></div>" & vbCrLf
strHTML = strHTML & "<div style=""position: absolute; width: 200px; height: 20px;"
strHTML = strHTML & "top: 6px;left: 6;"
strHTML = strHTML & "font-family: Arial; font-size: 18pt; color: #0000FF;"">"
strHTML = strHTML & "<b>" & strEmployeeID & "</b></div>" & vbCrLf
If Not (snpData Is Nothing) Then
Do While Not (snpData.EOF)
intShiftDay = DatePart("d", CDate(snpData("shift_date")))
Select Case CStr(snpData("indirect_id"))
Case "VAC", "VACB", "VACC", "VACF", "VACM"
lngDateBackColor(intShiftDay) = lngVacationBackColor
Case "HOL", "HOLC", "HOLF", "HOLB", "HOLM"
lngDateBackColor(intShiftDay) = lngHolidayBackColor
Case "BEREAVE", "BEREAVEC", "BEREAVEF", "BEREAVEB", "BEREAVEM"
lngDateBackColor(intShiftDay) = lngBereavementBackColor
Case "JURY", "JURYC", "JURYF", "JURYB", "JURYM"
lngDateBackColor(intShiftDay) = lngJuryDutyBackColor
Case "ABS", "ABSC", "ABSF", "ABSB", "ABSM"
lngDateBackColor(intShiftDay) = lngAbsentBackColor
Case "EXCUSE", "EXCUSEC", "EXCUSEF", "EXCUSEB", "EXCUSEM"
lngDateBackColor(intShiftDay) = lngExcusedBackColor
Case "MIL", "MILC", "MILF", "MILB", "MILM"
lngDateBackColor(intShiftDay) = lngMilitaryBackColor
End Select
'See if the month will change
intLastMonth = DatePart("m", CDate(snpData("shift_date")))
varDateMonthStart = DateSerial(DatePart("yyyy", CDate(snpData("shift_date"))), DatePart("m", CDate(snpData("shift_date"))), 1)
varDateMonthEnd = DateAdd("d", -1, DateAdd("m", 1, DateSerial(DatePart("yyyy", CDate(snpData("shift_date"))), DatePart("m", CDate(snpData("shift_date"))), 1)))
snpData.MoveNext
intOutputMonth = False
If snpData.EOF Then
intOutputMonth = True
Else
If DatePart("m", CDate(snpData("shift_date"))) <> intLastMonth Then
intOutputMonth = True
End If
End If
If intOutputMonth = True Then
intWeekdayStart = Weekday(varDateMonthStart)
intRow = intRow + 1
strHTML = strHTML & "<div style=""position: absolute; width: 200px; height: 20px;"
strHTML = strHTML & "top: " & CStr(intRow * 25 + 10) & "px;left: " & CStr(1 * 25) & ";"
strHTML = strHTML & "font-family: Arial; font-size: 14pt; color: #110011;"
strHTML = strHTML & "background-color: #FFFFFF;"">"
strHTML = strHTML & "<b>" & MonthName(DatePart("m", varDateMonthStart)) & " " & CStr(DatePart("yyyy", varDateMonthStart)) & "</b></div>" & vbCrLf
intRow = intRow + 1
strHTML = strHTML & "<div style=""position: absolute; width: 20px; height: 20px;"
strHTML = strHTML & "top: " & CStr(intRow * 25 + 10) & "px;left: " & CStr(1 * 25) & ";"
strHTML = strHTML & "font-family: Arial; font-size: 8pt; color: #4400FF;"
strHTML = strHTML & "background-color: #FFFFFF;"">"
strHTML = strHTML & "Sun</div>" & vbCrLf
strHTML = strHTML & "<div style=""position: absolute; width: 20px; height: 20px;"
strHTML = strHTML & "top: " & CStr(intRow * 25 + 10) & "px;left: " & CStr(2 * 25) & ";"
strHTML = strHTML & "font-family: Arial; font-size: 8pt; color: #4400FF;"
strHTML = strHTML & "background-color: #FFFFFF;"">"
strHTML = strHTML & "Mon</div>" & vbCrLf
strHTML = strHTML & "<div style=""position: absolute; width: 20px; height: 20px;"
strHTML = strHTML & "top: " & CStr(intRow * 25 + 10) & "px;left: " & CStr(3 * 25) & ";"
strHTML = strHTML & "font-family: Arial; font-size: 8pt; color: #4400FF;"
strHTML = strHTML & "background-color: #FFFFFF;"">"
strHTML = strHTML & "Tue</div>" & vbCrLf
strHTML = strHTML & "<div style=""position: absolute; width: 20px; height: 20px;"
strHTML = strHTML & "top: " & CStr(intRow * 25 + 10) & "px;left: " & CStr(4 * 25) & ";"
strHTML = strHTML & "font-family: Arial; font-size: 8pt; color: #4400FF;"
strHTML = strHTML & "background-color: #FFFFFF;"">"
strHTML = strHTML & "Wed</div>" & vbCrLf
strHTML = strHTML & "<div style=""position: absolute; width: 20px; height: 20px;"
strHTML = strHTML & "top: " & CStr(intRow * 25 + 10) & "px;left: " & CStr(5 * 25) & ";"
strHTML = strHTML & "font-family: Arial; font-size: 8pt; color: #4400FF;"
strHTML = strHTML & "background-color: #FFFFFF;"">"
strHTML = strHTML & "Thu</div>" & vbCrLf
strHTML = strHTML & "<div style=""position: absolute; width: 20px; height: 20px;"
strHTML = strHTML & "top: " & CStr(intRow * 25 + 10) & "px;left: " & CStr(6 * 25) & ";"
strHTML = strHTML & "font-family: Arial; font-size: 8pt; color: #4400FF;"
strHTML = strHTML & "background-color: #FFFFFF;"">"
strHTML = strHTML & "Fri</div>" & vbCrLf
strHTML = strHTML & "<div style=""position: absolute; width: 20px; height: 20px;"
strHTML = strHTML & "top: " & CStr(intRow * 25 + 10) & "px;left: " & CStr(7 * 25) & ";"
strHTML = strHTML & "font-family: Arial; font-size: 8pt; color: #4400FF;"
strHTML = strHTML & "background-color: #FFFFFF;"">"
strHTML = strHTML & "Sat</div>" & vbCrLf
intRow = intRow + 1
'Fill in the days from the previous month
For i = 1 To intWeekdayStart - 1
strHTML = strHTML & "<div style=""position: absolute; width: 20px; height: 20px;"
strHTML = strHTML & "top: " & CStr(intRow * 25) & "px;left: " & CStr(i * 25) & ";"
strHTML = strHTML & "font-family: Arial; font-size: 8pt; color: #FFFFFF;"
'Pad with leading 0s
strHTML = strHTML & "background-color: #" & String(6 - Len(Hex(lngOtherMonthBackColor)), "0") & Hex(lngOtherMonthBackColor) & ";"">"
strHTML = strHTML & DatePart("d", DateAdd("d", -(intWeekdayStart - i), varDateMonthStart)) & "</div>" & vbCrLf
Next
For i = 1 To DatePart("d", varDateMonthEnd)
'See if we need to jump to the next row
If i > 1 Then
'See if the week day is less than the previous week day - if so, jump to the next row in the calendar since the week changed
If Weekday(DateAdd("d", i - 1, varDateMonthStart)) < Weekday(DateAdd("d", i - 2, varDateMonthStart)) Then
intRow = intRow + 1
End If
End If
intCol = Weekday(DateAdd("d", i - 1, varDateMonthStart))
strHTML = strHTML & "<div style=""position: absolute; width: 20px; height: 20px;"
strHTML = strHTML & "top: " & CStr(intRow * 25) & "px;left: " & CStr(Weekday(DateAdd("d", i - 1, varDateMonthStart)) * 25) & ";"
strHTML = strHTML & "font-family: Arial; font-size: 8pt; color: #" & String(6 - Len(Hex(lngDateForeColor(i))), "0") & Hex(lngDateForeColor(i)) & ";"
strHTML = strHTML & "background-color: #" & String(6 - Len(Hex(lngDateBackColor(i))), "0") & Hex(lngDateBackColor(i)) & ";"">"
strHTML = strHTML & CStr(i) & "</div>" & vbCrLf
Next
'Finish out the final week
For i = Weekday(varDateMonthEnd) + 1 To 7
strHTML = strHTML & "<div style=""position: absolute; width: 20px; height: 20px;"
strHTML = strHTML & "top: " & CStr(intRow * 25) & "px;left: " & CStr(i * 25) & ";"
strHTML = strHTML & "font-family: Arial; font-size: 8pt; color: #FFFFFF;"
strHTML = strHTML & "background-color: #" & String(6 - Len(Hex(lngOtherMonthBackColor)), "0") & Hex(lngOtherMonthBackColor) & ";"">"
strHTML = strHTML & CStr(i - Weekday(varDateMonthEnd)) & "</div>" & vbCrLf
Next
intRow = intRow + 1
strHTML = strHTML & "<div style=""position: absolute; width: 20px; height: 12px;"
strHTML = strHTML & "top: " & CStr(intRow * 25) & "px;left: " & CStr(1 * 25) & ";"
strHTML = strHTML & "font-family: Arial; font-size: 7pt; color: #000000;"
strHTML = strHTML & "background-color: #" & String(6 - Len(Hex(lngVacationBackColor)), "0") & Hex(lngVacationBackColor) & ";"">"
strHTML = strHTML & "VAC</div>" & vbCrLf
strHTML = strHTML & "<div style=""position: absolute; width: 20px; height: 12px;"
strHTML = strHTML & "top: " & CStr(intRow * 25) & "px;left: " & CStr(2 * 25) & ";"
strHTML = strHTML & "font-family: Arial; font-size: 7pt; color: #000000;"
strHTML = strHTML & "background-color: #" & String(6 - Len(Hex(lngHolidayBackColor)), "0") & Hex(lngHolidayBackColor) & ";"">"
strHTML = strHTML & "HOL</div>" & vbCrLf
strHTML = strHTML & "<div style=""position: absolute; width: 20px; height: 12px;"
strHTML = strHTML & "top: " & CStr(intRow * 25) & "px;left: " & CStr(3 * 25) & ";"
strHTML = strHTML & "font-family: Arial; font-size: 7pt; color: #000000;"
strHTML = strHTML & "background-color: #" & String(6 - Len(Hex(lngBereavementBackColor)), "0") & Hex(lngBereavementBackColor) & ";"">"
strHTML = strHTML & "BER</div>" & vbCrLf
strHTML = strHTML & "<div style=""position: absolute; width: 20px; height: 12px;"
strHTML = strHTML & "top: " & CStr(intRow * 25) & "px;left: " & CStr(4 * 25) & ";"
strHTML = strHTML & "font-family: Arial; font-size: 7pt; color: #000000;"
strHTML = strHTML & "background-color: #" & String(6 - Len(Hex(lngJuryDutyBackColor)), "0") & Hex(lngJuryDutyBackColor) & ";"">"
strHTML = strHTML & "JUR</div>" & vbCrLf
strHTML = strHTML & "<div style=""position: absolute; width: 20px; height: 12px;"
strHTML = strHTML & "top: " & CStr(intRow * 25) & "px;left: " & CStr(5 * 25) & ";"
strHTML = strHTML & "font-family: Arial; font-size: 7pt; color: #000000;"
strHTML = strHTML & "background-color: #" & String(6 - Len(Hex(lngAbsentBackColor)), "0") & Hex(lngAbsentBackColor) & ";"">"
strHTML = strHTML & "ABS</div>" & vbCrLf
strHTML = strHTML & "<div style=""position: absolute; width: 20px; height: 12px;"
strHTML = strHTML & "top: " & CStr(intRow * 25) & "px;left: " & CStr(6 * 25) & ";"
strHTML = strHTML & "font-family: Arial; font-size: 7pt; color: #000000;"
strHTML = strHTML & "background-color: #" & String(6 - Len(Hex(lngExcusedBackColor)), "0") & Hex(lngExcusedBackColor) & ";"">"
strHTML = strHTML & "EXC</div>" & vbCrLf
strHTML = strHTML & "<div style=""position: absolute; width: 20px; height: 12px;"
strHTML = strHTML & "top: " & CStr(intRow * 25) & "px;left: " & CStr(7 * 25) & ";"
strHTML = strHTML & "font-family: Arial; font-size: 7pt; color: #000000;"
strHTML = strHTML & "background-color: #" & String(6 - Len(Hex(lngMilitaryBackColor)), "0") & Hex(lngMilitaryBackColor) & ";"">"
strHTML = strHTML & "MIL</div>" & vbCrLf
'Reset the starting colors
For i = 1 To 31
lngDateBackColor(i) = RGB(230, 230, 230) 'Off White
lngDateForeColor(i) = RGB(0, 0, 0) 'Black
Next
End If
Loop
snpData.Close
End If
'Fire up Internet Explorer
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Left = 0
objIE.Top = 0
objIE.Width = 260
objIE.Height = 700
objIE.StatusBar = False
objIE.MenuBar = False
objIE.Toolbar = False
objIE.Navigate "about:blank"
objIE.Document.Body.InnerHTML = strHTML
objIE.Document.Title = "Attendance " & strEmployeeID
objIE.Visible = True
'with the help of custom program, set a 1 second delay, then force the Attendance web page to the top
Set objShell = CreateObject("WScript.Shell")
objShell.Run("C:\BringToTop.exe " & Chr(34) & "Attendance " & strEmployeeID & Chr(34) & " 1")
Set objShell = Nothing
Set snpData = Nothing
Set objIE = Nothing
Set OracleSQL = Nothing
While the above uses a custom DLL for the database connection, a standard ADO connection will work just as well. The script also uses a custom program that I created called BringToTop that simply addresses the “pop under” behavior on Vista and Windows 7.
So, which employee has the best attendance record?
Recent Comments