Code:
Public Function CompletedWorkordershtm()
'This Function outputs an HTM file that is called CompletedWorkorders.htm. It displays 50 most recent Complete batch records.
'They are displayed in, as most recently updated.
'
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(CurrentProject.Path & "\CompletedWorkorders.htm", True)
'Declare Variables
Dim brID(51) As Variant
Dim brRecordNum As Integer
brRecordNum = 0
Dim db As DAO.Database
'Variables for SQL strings
Dim brSQL As String
brSQL = "SELECT TOP 50 Batch_Record.ID, " _
& "Batch_Record.BRDate, " _
& "Batch_Record.ThorneID, " _
& "Batch_Record.ProductFormula, " _
& "Batch_Record.LastUpdate, " _
& "Batch_Record.CompletedDate " _
& "FROM Batch_Record " _
& "WHERE (((Batch_Record.Status) = ""COMPLETE""))" _
& "ORDER BY Batch_Record.LastUpdate DESC"
Set db = CurrentDb
Set BRrst = db.OpenRecordset(brSQL)
a.WriteLine ("<!DOCTYPE html>")
a.WriteLine ("<html>")
a.WriteLine ("<head>")
a.WriteLine ("<link rel=""stylesheet"" type=""text/css"" href=""cssfile.css"">")
a.WriteLine (" <img src=""thorne.jpg"" align = ""right"" /> <H1>  Completed Workorders</h1>")
a.WriteLine ("Generated: ")
a.WriteLine (Now())
a.WriteLine ("<br><div>")
a.WriteLine ("<script src=""navbar.js"" type=""text/javascript""> </script>")
a.WriteLine ("</div>")
a.WriteLine ("</head>")
a.WriteLine ("<body>")
If BRrst.RecordCount > 0 Then
BRrst.MoveFirst
Do Until BRrst.EOF
'Make sure we dont over run the array
If brRecordNum < 100 Then
brID(brRecordNum) = BRrst.Fields(0)
a.WriteLine ("<table>")
a.WriteLine ("<tr><td> <td></tr>")
a.WriteLine ("<tr><td>Thorne ID   <b>" & BRrst.Fields(2) & "</b></td><tr>")
a.WriteLine ("<tr><td>Formula      <b>" & BRrst.Fields(3) & "</b></td><tr>")
a.WriteLine ("<tr><td>Date Entered       " & Format(BRrst(1), "mm/dd/yyyy") & "</td></tr>")
a.WriteLine ("<tr><td>Date Completed  " & Format(BRrst(5), "mm/dd/yyyy") & "</td></tr>")
a.WriteLine ("<tr><td>            Updated  " & Format(BRrst(4), "mm/dd/yyyy HH:MM:SS") & "</td></tr>")
a.WriteLine ("</table>")
a.WriteLine ("<table>")
'create the SQL queries for Dashboard output.
yldSQL = "SELECT Batch_Record_Details_Yield.BatchRecord_FK, " _
& "Batch_Record_Details_Yield.Department, " _
& "Batch_Record_Details_Yield.Units, " _
& "Batch_Record_Details_Yield.Start_Units, " _
& "Batch_Record_Details_Yield.End_Units, " _
& "Batch_Record_Details_Yield.Yield " _
& "FROM Batch_Record_Details_Yield " _
& "WHERE (((Batch_Record_Details_Yield.BatchRecord_FK)=" & brID(brRecordNum) & "))"
eqSQL = "SELECT Batch_Record_Details_Equipment.Department, " _
& "Batch_Record_Details_Equipment.Equipment, " _
& "Batch_Record_Details_Equipment.KPI_Code, " _
& "Batch_Record_Details_Equipment.Start_Time, " _
& "Batch_Record_Details_Equipment.End_Time, " _
& "Batch_Record_Details_Equipment.tTime " _
& "FROM Batch_Record_Details_Equipment " _
& "WHERE (((Batch_Record_Details_Equipment.BatchRecord_FK)=" & brID(brRecordNum) & "))"
prsnlSQL = "SELECT Batch_Record_Details_Personnel.Department, " _
& "Batch_Record_Details_Personnel.Employee, " _
& "Batch_Record_Details_Personnel.KPICode, " _
& "Batch_Record_Details_Personnel.Start_Time, " _
& "Batch_Record_Details_Personnel.End_Time, " _
& "Batch_Record_Details_Personnel.tTime " _
& "FROM Batch_Record_Details_Personnel " _
& "WHERE (((Batch_Record_Details_Personnel.BatchRecord_FK)=" & brID(brRecordNum) & "))"
'Begin Yield Dashboard Output
Set YLDrst = db.OpenRecordset(yldSQL)
Set EQrst = db.OpenRecordset(eqSQL)
Set PRSNLrst = db.OpenRecordset(prsnlSQL)
'Test to see if there are records, if so, output them
Dim OverallYield As Double
OverallYield = 1
If YLDrst.RecordCount > 0 Then
YLDrst.MoveFirst
'Table Header
a.WriteLine ("<tr><td id = """ & "heading" & """ ><b>Yield</b></td></tr><tr><th>Department</th><th>Start Units</th><th>End Units</th><th>Yield %</th><th></th><th></th></tr>")
Do Until YLDrst.EOF
OverallYield = OverallYield * YLDrst(5)
a.WriteLine ("<tr><td>" & YLDrst(1) & "</td><td>" & Format(YLDrst(3), "#,###,###") & YLDrst(2) & "</td><td>" & Format(YLDrst(4), "#,###,###") & YLDrst(2) & "</td><td>" & FormatPercent(YLDrst(5)) & "</td></tr>")
YLDrst.MoveNext
Loop
a.WriteLine ("<tr><td> </td><td> </td><td id = """ & "total" & """ &><u>Overall Yield</td><td id = """ & "total" & """ &><u>" & FormatPercent(OverallYield) & "</u></td><tr>")
End If
Dim TotalHrs As Double
Dim dMixing As Double
Dim dEncap As Double
Dim dPackaging As Double
Dim dPowderfill As Double
Dim dSorting As Double
dMixing = 0
dEncap = 0
dPackaging = 0
dPowderfill = 0
dSorting = 0
'Test to see if there are records, if so, output them
If EQrst.RecordCount > 0 Then
EQrst.MoveFirst
'Table header
a.WriteLine ("<tr><td id = """ & "heading" & """ ><b>Equipment</b></td></tr><tr><th>Department</th><th>Equipment</th><th>KPI Code</th><th>Start Time</th><th>End Time</th><th>Total Time</th></tr>")
TotalHrs = 0
Do Until EQrst.EOF
If EQrst(0) = "Mixing" Then
dMixing = dMixing + EQrst(5)
End If
If EQrst(0) = "Encap" Then
dEncap = dEncap + EQrst(5)
End If
If EQrst(0) = "Packaging" Then
dPackaging = dPackaging + EQrst(5)
End If
If EQrst(0) = "Powderfill" Then
dPowderfill = dPowderfill + EQrst(5)
End If
If EQrst(0) = "Sorting" Then
dSorting = dSorting + EQrst(5)
End If
a.WriteLine ("<tr><td>" & EQrst(0) & "</td><td>" & EQrst(1) & "</td><td>" & EQrst(2) & "</td><td>" & Format(EQrst(3), "mm/dd/yyyy HH:MM") & "</td><td>" & Format(EQrst(4), "mm/dd/yyyy HH:MM") & "</td><td>" & Format(EQrst(5), "0.00") & "</td><tr>")
If EQrst(5) > 0 Then
TotalHrs = TotalHrs + EQrst(5)
End If
EQrst.MoveNext
Loop
'Output total hours
a.WriteLine ("<tr><td></td><td> </td><td> </td><td> </td></td><td><u>Total Mixing Time</td><td><u>" & Format(dMixing, "0.00") & "</u></td><tr>")
a.WriteLine ("<tr><td></td><td> </td><td> </td><td> </td></td><td><u>Total Encap Time</td><td><u>" & Format(dEncap, "0.00") & "</u></td><tr>")
a.WriteLine ("<tr><td></td><td> </td><td> </td><td> </td></td><td><u>Total Sorting Time</td><td><u>" & Format(dSorting, "0.00") & "</u></td><tr>")
a.WriteLine ("<tr><td></td><td> </td><td> </td><td> </td></td><td><u>Total Packaging Time</td><td><u>" & Format(dPackaging, "0.00") & "</u></td><tr>")
a.WriteLine ("<tr><td></td><td> </td><td> </td><td> </td></td><td><u>Total Powderfill Time</td><td><u>" & Format(dPowderfill, "0.00") & "</u></td><tr>")
a.WriteLine ("<tr><td></td><td> </td><td> </td><td> </td><td id = """ & "total" & """ &><u>Run Total Hrs</td><td id = """ & "total" & """ &><u>" & Format(TotalHrs, "0.00") & "</u></td><tr>")
End If
'Reset hour counters
dMixing = 0
dEncap = 0
dPackaging = 0
dPowderfill = 0
dSorting = 0
'Test to see if there are records, if so, output them
If PRSNLrst.RecordCount > 0 Then
PRSNLrst.MoveFirst
'Table header
a.WriteLine ("<tr><td id = """ & "heading" & """><b>Personnel</b></td></tr><tr><th>Department</th><th>Employee</th><th>KPI Code</th><th>Start Time</th><th>End Time</th><th>Total Time</th></tr>")
TotalHrs = 0
Do Until PRSNLrst.EOF
If PRSNLrst(0) = "Mixing" Then
dMixing = dMixing + PRSNLrst(5)
End If
If PRSNLrst(0) = "Encap" Then
dEncap = dEncap + PRSNLrst(5)
End If
If PRSNLrst(0) = "Packaging" Then
dPackaging = dPackaging + PRSNLrst(5)
End If
If PRSNLrst(0) = "Powderfill" Then
dPowderfill = dPowderfill + PRSNLrst(5)
End If
If PRSNLrst(0) = "Sorting" Then
dSorting = dSorting + PRSNLrst(5)
End If
a.WriteLine ("<tr><td>" & PRSNLrst(0) & "</td><td>" & PRSNLrst(1) & "</td><td>" & PRSNLrst(2) & "</td><td>" & Format(PRSNLrst(3), "mm/dd/yyyy HH:MM") & "</td><td>" & Format(PRSNLrst(4), "mm/dd/yyyy HH:MM") & "</td><td>" & Format(PRSNLrst(5), "0.00") & "</td><tr>")
If PRSNLrst(5) > 0 Then
TotalHrs = TotalHrs + PRSNLrst(5)
End If
PRSNLrst.MoveNext
Loop
'Output total hours
a.WriteLine ("<tr><td></td><td> </td><td> </td><td> </td></td><td><u>Total Mixing Time</td><td><u>" & Format(dMixing, "0.00") & "</u></td><tr>")
a.WriteLine ("<tr><td></td><td> </td><td> </td><td> </td></td><td><u>Total Encap Time</td><td><u>" & Format(dEncap, "0.00") & "</u></td><tr>")
a.WriteLine ("<tr><td></td><td> </td><td> </td><td> </td></td><td><u>Total Sorting Time</td><td><u>" & Format(dSorting, "0.00") & "</u></td><tr>")
a.WriteLine ("<tr><td></td><td> </td><td> </td><td> </td></td><td><u>Total Packaging Time</td><td><u>" & Format(dPackaging, "0.00") & "</u></td><tr>")
a.WriteLine ("<tr><td></td><td> </td><td> </td><td> </td></td><td><u>Total Powderfill Time</td><td><u>" & Format(dPowderfill, "0.00") & "</u></td><tr>")
a.WriteLine ("<tr><td></td><td> </td><td> </td><td> </td><td id = """ & "total" & """ &><u>Personnel Total Hrs</td><td id = """ & "total" & """ &><u>" & Format(TotalHrs, "0.00") & "</u></td><tr>")
End If
a.WriteLine ("<tr><td><hr width = 105%></td><td><hr width = 105%></td><td><hr width = 105%></td><td><hr width = 105%></td><td><hr width = 105%></td></tr>")
BRrst.MoveNext
brRecordNum = brRecordNum + 1
End If
Loop
End If
a.WriteLine ("</table>")
a.WriteLine ("</html>")
BRrst.Close
Set BRrst = Nothing
db.Close
Set db = Nothing
'close html file
a.Close
End Function