Output Employee Attendance Calendar to Web with VBS

16 12 2009

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?


Actions

Information

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s




Follow

Get every new post delivered to your Inbox.

Join 143 other followers

%d bloggers like this: