Step Writing VBA Procedures for the Command Buttons

1. Start by writing a simple VBA procedure that will clear the timesheet when the user clicks the Clear button. This procedure should clear unprotected cells in the spreadsheet, except for the Employee name stored in cell C4. Note that when you are done writing VBA procedures, you should protect your timesheet so users can enter data only in the designated cells and cell ranges. The procedure assigned to the

Clear button will also be automatically called after the timesheet data has been successfully submitted. The cmdClear_Click procedure is shown below.

Private Sub cmdClear_Click() ActiveSheet.Unprotect Range("C5").ClearContents Range("RegularHrs").ClearContents Range("Overtime").ClearContents ActiveSheet.Protect End Sub

2. Write the code for the cmdMyTime_Click procedure that is assigned to the My Timesheets button on the spreadsheet. This procedure will retrieve data from the TimeTrack database for the indicated employee when the user clicks the My Timesheets button.

Private Sub cmdMyTime_Click() Dim conn As ADODB.Connection Dim rst As ADODB.Recordset Dim strEmpName As String Dim strDB As String Dim strSQL As String Dim fldCount As Integer Dim recCount As Long

Dim c As Integer ' column index

Dim r As Integer ' row index

Dim TShId As String

On Error GoTo ErrorHandler

If IsEmpty(Range("C4")) Then

MsgBox "Please enter Employee Name.", _

vbInformation, "Missing Employee Name" Exit Sub End If strEmpName = Range("C4").Value

' Set the path of your TimeTrack database strDB = "c:\inetpub\wwwroot\TimeTrack\timeTrack.mdb"

' Open connection to the database Set conn = New ADODB.Connection conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" &_ "Data Source=" & strDB & ";"

' Open recordset based on tblTimeSheets table

Set rst = New ADODB.Recordset strSQL = "SELECT * From tblTimeSheets"

strSQL = strSQL & " WHERE EmpName ='" & strEmpName &

rst.Open strSQL, conn

If rst.EOF Then

MsgBox "Database does not have any records for " & _

strEmpName & "." GoTo ExitHere End If

Sheets(2).Select ActiveSheet.Cells.Clear

' Copy field names to the first row of the worksheet fldCount = rst.Fields.Count For c = 1 To fldCount

ActiveSheet.Cells(1, c).Value = rst.Fields(c - 1).Name

Next

' Copy the recordset to the worksheet, starting in cell A2 ActiveSheet.Cells(2, 1).CopyFromRecordset rst

' store all timesheet IDs in a variable ActiveSheet.Cells(2, 1).Select Do Until IsEmpty(ActiveCell)

TShId = TShId & ActiveCell.Value & "," ActiveCell.Offset(1, 0).Select Loop

' Open a new recordset based on the tblTimesheetDetails table

Set rst = New ADODB.Recordset strSQL = "SELECT * FROM tblTimesheetDetails"

strSQL = strSQL & " WHERE TSheetId in (" & TShId & ")"

strSQL = strSQL & " ORDER BY TSheetId, Weekday(CalDate, 2)"

rst.Open strSQL, conn

' Copy field names to the first row of the worksheet ' beginning in Column G fldCount = rst.Fields.Count For c = 1 To fldCount

ActiveSheet.Cells(1, c + 6).Value = rst.Fields(c - 1).Name Next

ActiveSheet.Range("G2").CopyFromRecordset rst ActiveSheet.Cells(1, 1).Select

ErrorHandler:

MsgBox Err.Description GoTo ExitHere

End If ExitHere: rst.Close Set rst = Nothing conn.Close Set conn = Nothing End Sub

3. Write the code for the cmdSubmit_Click procedure that is assigned to the Submit button on the spreadsheet. This procedure posts data from the spreadsheet range to the ASP page (Timesheet.asp). Notice that the procedure begins with a call to the ValidateData function. See this function's code following the code of the cmdSubmit_Click procedure.

You can post data to Active Server Pages by using the XMLHTTP object of the XML DOM object model. When you use the XMLHTTP object, the XML data is passed over the Internet using the standard HTTP protocol. Sending data begins by opening a "POST" connection to your web server. To create the XMLHTTP object and set it up, the procedure uses the following code:

' Submit the XMLSS to the ASP page for processing

Set myHTTP = New MSXML2.XMLHTTP30

myHTTP.Open "Post", sFolder & "TimeSheet.asp", False

In the above code fragment the sFolder is a constant pointing to the "http://localhost/Time/" folder where the ASP page (which you will create later) is located. The False, in the place of the third parameter of the Open method, indicates that communication between client and server will be handled synchronously. This means that the client machine will wait until the response is returned from the server.

Once the connection to the web server is open, use the Send method of the XMLHTTP object to send the XML data to the receiving ASP page:

myHTTP.send resultXML

In the above statement, resultXML is the XML document that you obtained after transforming the XML spreadsheet data from the Excel range into the custom format using the Timesheet.xls stylesheet (the code of the stylesheet is shown later in this chapter).

It is always useful during procedure testing to see what was actually sent to the web server, so use these two debugging statements to find out:

Debug.Print resultXML.XML Debug.Print resultXML.Text

The ASP page that receives the data will contain code to process the data and write the response to the client. You can retrieve the processing result from the XMLHTTP object's responseText property:

' Get response from ASP page Set myResponse = New MSXML2.DOMDocument30 myResponse.Load myHTTP.responseXML Debug.Print myHTTP.responseText

Here's the complete code for the cmdSubmit_Click procedure:

Private Sub cmdSubmit_Click() ' Declarations

Dim timeRangeXML As MSXML2.DOMDocument30 Dim timeXSL As MSXML2.D0MDocument30 Dim resultXML As MSXML2.D0MDocument30 Dim myHTTP As MSXML2.XMLHTTP30 Dim myResponse As MSXML2.D0MDocument30

Dim strStatus As String

On Error GoTo ErrorHandler

Const sFolder = "http://localhost/Time/"

' call the ValidateData function If ValidateData = False Then Exit Sub

' Load a new DOMDocument using range B4:E16 Set timeRangeXML = New MSXML2.D0MDocument30

timeRangeXML.LoadXML Range("B4:E16").Value(xlRangeValueXMLSpreadsheet)

' Transform the XMLSS spreadsheet to custom XML Set timeXSL = New MSXML2.D0MDocument30 timeXSL.Load ThisWorkbook.Path & "\Timesheet.xsl"

Set resultXML = New MSXML2.D0MDocument30 timeRangeXML.transformNodeToObject timeXSL, resultXML

' Submit the XMLSS to the ASP page for processing Set myHTTP = New MSXML2.XMLHTTP30 myHTTP.Open "Post", sFolder & "TimeSheet.asp", False myHTTP.send resultXML

' See what was sent Debug.Print resultXML.XML Debug.Print resultXML.Text

' Get response from ASP page

Set myResponse = New MSXML2.DOMDocument30

myResponse.Load myHTTP.responseXML

Debug.Print myHTTP.responseText

strStatus = myResponse.selectSingleNode("//Status").Text

If strStatus = "Success" Then

MsgBox "You have successully submitted " & vbCrLf _ & "the timesheet for the week ending " & _ Range("EndingDate").Value & ".", _ vblnformation, "Congratulations!"

Else

MsgBox strStatus End If cmdClear_Click Exit Sub ErrorHandler:

MsgBox Err.Number & ": " & Err.Description End Sub

Prior to posting data to the server, it is always a good idea to validate it on the client. The ValidateData function is called by the cmdSubmit_Click procedure. This function ensures that users enter complete and valid data.

4. Enter the following ValidateData function below the code of the cmdSubmit_Click procedure.

Function ValidateData() Dim strMsg As String Dim strReg As String Dim strOvt As String Dim response As Integer Dim cell As Variant Dim blnNotNumber As Boolean

ValidateData = True strMsg = ""

If Range("C4").Value = "" Then strMsg = strMsg & " * Employee name" & vbCrLf End If

If Range("C5").Value = "" Then strMsg = strMsg & " * Week-ending date" & vbCrLf End If

For Each cell In Range("D9:D15")

If IsEmpty(cell) Or Not IsNumeric(cell) Then strReg = strReg & cell.Offset(0, -2).Value & " " End If

Next

If strReg <> "" Then strMsg = strMsg & " * Regular hrs for: " & strReg & vbCrLf End If

For Each cell In Range("E9:E15")

If IsEmpty(cell) Or Not IsNumeric(cell) Then strOvt = strOvt & cell.Offset(0, -3).Value & " " If Not IsNumeric(cell) Then blnNotNumber = True End If End If

Next

If strOvt <> "" Then strMsg = strMsg & " * Overtime hrs for: " & strOvt strMsg = strMsg & vbCrLf & vbCrLf If blnNotNumber = False Then strMsg = strMsg & "Do you want to enter zeros for overtime?" End If End If

If strMsg <> "" Then strMsg = "The following data is missing: " & vbCrLf & vbCrLf & strMsg Else

Exit Function End If

If strOvt <> "" And blnNotNumber = False Then response = MsgBox(strMsg, vbYesNo + vbExclamation, _

"Incomplete Data") If response = vbYes And blnNotNumber = False Then Range("E9:E15").Select ActiveSheet.Unprotect

Selection.SpecialCells(xlCellTypeBlanks).Select Selection.FormulaR1C1 = "0" ActiveSheet.Protect End If

Else

MsgBox strMsg, vbExclamation, "Incomplete Data" End If

ValidateData = False End Function

0 0

Post a comment