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.
Leave a Reply