Hi Guy's i am trying to output a recordset to Excel, working successfully with one little adjustment required, would appreciated if the code i post can be adjusted wherever the running sum needs to be ?
So if there is 5 records in rs record count
The first record is correct, the next 4 are incorrect, some of the fields (Cells) need to calculate from the last record ie: record 2 certain cells mentioned cells needs to from previous record then the calculation, same for record 3 needs to be record 1 and record 2 then the calculation etc
so record in this case the highlighted cells needs to be calculated from the 4 previous records then the calculation
Please forgive me if i haven't explained correctly but hope i have, i think I'm just mind boggled in how to do it!!!!!
Code
Code:
Dim pOpen As String, fOpen As String, apXL As Object, xlWB As Object, xlWS As ObjectDim rs As DAO.Recordset, strSQL As String, msMin As Integer, msMax As Integer
Dim myDriver As String, myStart As Date, myEnd As Date
Dim LR As Long
If Me.txtIndexNo = "2" Then
myDriver = Me.cboDriver
myStart = Format(Me.txtStartDate, "mm/dd/yyyy")
myEnd = Format(Me.txtEndDate, "mm/dd/yyyy")
xlPath = "T:\DMT Ltd\XL Files\Driver Hours\" & Me.cboDriver & "\"
xlFileName = Me.cboDriver & ".xlsx"
Set rs = CurrentDb.OpenRecordset("Select tblDriverHours.StartDate, tblDriverHours.MSNo, tblDriverHours.StartTime, tblDriverHours.FinishTime, tblDriverHours.RestBreak, tblDriverHours.HoursDone, tblDriverHours.StdHours From tblDriverHours WHERE Driver = '" & myDriver & "' And StartDate Between #" & myStart & "# And #" & myEnd & "#")
pOpen = "T:\DMT Ltd\XL Files\Driver Hours\" & Me.cboDriver & "\"
fOpen = Me.cboDriver & ".xlsx"
Set apXL = CreateObject("Excel.Application")
Set xlWB = apXL.Workbooks.Open(pOpen & fOpen)
apXL.Workbooks.Open pOpen & fOpen, True, False
Set xlWS = xlWB.Worksheets("Time Sheet")
apXL.Visible = False
With xlWB
rs.MoveFirst
Do Until rs.EOF
MsgBox ("There Are: " & rs.RecordCount & " Records To Output"), vbInformation + vbOKOnly, "RECORD COUNT"
LR = xlWS.Cells(xlWS.Rows.Count, 1).End(xlUp).Row
.Worksheets(1).Cells(LR + 1, 1) = Format(rs.Fields("StartDate"), "ddd-dd-mmm-yyyy")
.Worksheets(1).Cells(LR + 1, 2) = rs.Fields("MSNo")
.Worksheets(1).Cells(LR + 1, 3) = Format(rs.Fields("StartTime"), "00:00")
.Worksheets(1).Cells(LR + 1, 4) = Format(rs.Fields("FinishTime"), "00:00")
.Worksheets(1).Cells(LR + 1, 5) = rs.Fields("RestBreak")
.Worksheets(1).Cells(LR + 1, 6) = rs.Fields("HoursDone")
.Worksheets(1).Cells(LR + 1, 7) = rs.Fields("StdHours")
.Worksheets(1).Cells(LR + 1, 8) = rs.Fields("StdHours") - rs.Fields("HoursDone")
.Worksheets(1).Cells(LR + 1, 10) = rs.Fields("HoursDone") - rs.Fields("StdHours") - rs.Fields("RestBreak")
.Worksheets(1).Cells(LR + 1, 11) = rs.Fields("StdHours") - rs.Fields("HoursDone") + rs.Fields("RestBreak")
'.Worksheets(1).Cells(LR + 1, 1).CopyFromRecordset rs
.Worksheets(1).Cells.EntireColumn.HorizontalAlignment = xlLeft
rs.MoveNext
Loop
.Save
End With
xlWB.Close
apXL.Quit
Set xlWS = Nothing
Set apXL = Nothing
Set rs = Nothing
MsgBox ("Sucessfully Updated" & vbNewLine & vbNewLine & _
"Click Open In Excel Button"), vbInformation + vbOKOnly, "UPDATE SUCESSFULL"
End If
Record quantities may vary but never typically any more than 5 or 6
Result with records 2 to 5 incorrect values