edfreels
asked on
Access DB RunTime Error Query is too complex
We have an access db that tracks different things like mileage etc. When the user enters the date for example 4-1-2007 to 4-30-2007 and does a show range and process totals we get the RunTime Error 3360 - Query is too complex. Here is the piece of code that errors out. The db1.Execute line is the one that is highlighted when we debug.
subAddErrCode:
Set rcst1 = Forms!frm_IFTA_Mileage_Ent ryEdit.Chi ld41.Form. RecordsetC lone
If rcst1.RecordCount <> 0 Then
db1.Execute ("UPDATE tbl_Haul_Data_Mileage SET ErrCode = " & intErrCode & " " & strWhereClause & ";")
End If
rcst1.Close
Set rcst1 = Nothing
Return
Thanks
subAddErrCode:
Set rcst1 = Forms!frm_IFTA_Mileage_Ent
If rcst1.RecordCount <> 0 Then
db1.Execute ("UPDATE tbl_Haul_Data_Mileage SET ErrCode = " & intErrCode & " " & strWhereClause & ";")
End If
rcst1.Close
Set rcst1 = Nothing
Return
Thanks
whats in your wherclause?
ASKER
Here is all of the code
Option Compare Database
Option Explicit
Dim db1 As dao.Database
Dim db2 As dao.Database
Dim rcst1 As dao.Recordset
Dim rcst2 As dao.Recordset
Dim frm1 As Form 'Use frm1a and frm2a so we don't inadvertantly
Dim frm2 As Form 'kill a reference by making an outside procedure call
Dim frm1a As Form
Dim frm2a As Form
Dim strWhereClause As String
Dim strFilterClause As String
Dim strDateRangeClause As String
Dim strMessage As String
Dim strBadStateArray() As String
Dim strBadGuyClause As String
Dim strOrderByClause As String
Dim intNewMRecID As Integer
Dim intErrCode As Integer
Dim intCntr1 As Integer
Dim intCntr2 As Integer
Public Sub subGetStartUpParameters()
GoSub subSetUp
GoSub subGetMileageLimits
GoSub subGetCurrentMonth
GoSub subCloseUp
subSetUp:
Set frm1 = Forms!frm_IFTA_Mileage_Ent ryEdit
Return
subGetMileageLimits:
frm1.txtHighMileageLimit = DLookup("[HighMileageFacto r]", "tbl_Ref_Mileage_Factors")
frm1.txtLowMileageLimit = DLookup("[LowMileageFactor ]", "tbl_Ref_Mileage_Factors")
frm1.txtHighMPGLimit = DLookup("[HighMPGFactor]", "tbl_Ref_Mileage_Factors")
frm1.txtLowMPGLimit = DLookup("[LowMPGFactor]", "tbl_Ref_Mileage_Factors")
Return
subGetCurrentMonth:
frm1.TxtBegin.Value = Format((DateAdd("d", -Day(Date) + 1, Date)), "mm/dd/yy") 'First day of the current month
frm1.TxtEnd.Value = Format(Date, "mm/dd/yy") 'Current Day
Call subSetMileageRange
Return
subCloseUp:
Set frm1 = Nothing
Exit Sub
End Sub
Public Sub subSetMileageRange()
Dim strMsg As String
Dim strBegin As String
Dim strEnd As String
GoSub subSetUp
GoSub subCheckDates
GoSub subRunFilter
GoSub subCloseUp
subSetUp:
strDateRangeClause = ""
Set frm1 = Forms!frm_IFTA_Mileage_Ent ryEdit
Set frm2 = Forms!frm_IFTA_Mileage_Ent ryEdit.Chi ld41.Form
Return
subCheckDates:
If Not IsDate(frm1.TxtBegin) Then
strMsg = "-Begin Date- is not a date"
Else
strBegin = frm1.TxtBegin
End If
If Not IsDate(frm1.TxtEnd) Then
strMsg = strMsg & vbCrLf & "-End Date- is not a date"
Else
strEnd = frm1.TxtEnd
End If
If strMsg <> "" Then
MsgBox strMsg & vbCrLf & strBegin & strEnd
GoSub subCloseUp
End If
Return
subRunFilter:
strDateRangeClause = " ((HaulingDate)>=#" & strBegin & "# And (HaulingDate)<=#" & strEnd & "#)"
frm2.FilterOn = True
frm2.Filter = strDateRangeClause
Call subStowMileageFilter
Return
subCloseUp:
Set frm1 = Nothing
Set frm2 = Nothing
Exit Sub
End Sub
Public Sub subSortMileage()
GoSub subSetUp
GoSub subRunFilter
GoSub subCloseUp
subSetUp:
Set frm2 = Forms!frm_IFTA_Mileage_Ent ryEdit.Chi ld41.Form
strOrderByClause = "TruckID, HaulingDate, BeginningMiles, EndingMiles"
Return
subRunFilter:
frm2.OrderByOn = True
frm2.OrderBy = strOrderByClause
Return
subCloseUp:
Set frm2 = Nothing
Exit Sub
End Sub
Public Sub subStowMileageFilter()
Set frm1a = Forms!frm_IFTA_Mileage_Ent ryEdit
Set frm2a = Forms!frm_IFTA_Mileage_Ent ryEdit.Chi ld41.Form
strWhereClause = " WHERE " & frm2a.Filter
frm1a.Label14.Caption = frm2a.Filter
Set frm1a = Nothing
Set frm2a = Nothing
End Sub
Public Sub subUpDateStageOne() 'Update MilesDriven, InStateMiles, MPG,
GoSub subSetUp 'Set empty strings to null so they can be tested on Null later
GoSub subUpdate
GoSub subCloseUp
subSetUp:
Set db1 = CurrentDb
Set frm2 = Forms!frm_IFTA_Mileage_Ent ryEdit.Chi ld41.Form
Return
subUpdate:
db1.Execute ("UPDATE tbl_Haul_Data_Mileage " _
& "SET tbl_Haul_Data_Mileage.Begi nningMiles = " _
& "IIf(IsNull([BeginningMile s]),0,[Beg inningMile s]), " _
& "tbl_Haul_Data_Mileage.End ingMiles = " _
& "IIf(IsNull([EndingMiles]) ,0,[Ending Miles])," _
& "tbl_Haul_Data_Mileage.InS tateMiles = " _
& "IIf(IsNull([InStateMiles] ),0,[InSta teMiles]), " _
& "tbl_Haul_Data_Mileage.Out StateMiles = " _
& "IIf(IsNull([OutStateMiles ]),0,[OutS tateMiles] )" & strWhereClause & ";")
db1.Execute ("UPDATE tbl_Haul_Data_Mileage " _
& "SET tbl_Haul_Data_Mileage.Mile sDriven = " _
& "([EndingMiles]-[Beginning Miles])" & strWhereClause & ";")
db1.Execute ("UPDATE tbl_Haul_Data_Mileage " _
& "SET tbl_Haul_Data_Mileage.InSt ateMiles = " _
& "([MilesDriven]-[OutStateM iles])" & strWhereClause & ";")
db1.Execute ("UPDATE tbl_Haul_Data_Mileage " _
& "SET tbl_Haul_Data_Mileage.MPG = " _
& "IIf([MilesDriven]<>0, " _
& "IIf(IsNull([TruckFuelGall ons]), " _
& "IIf(IsNull([OutOfStateFue l]),Null, " _
& "IIf([OutOfStateFuel]<>0,[ MilesDrive n]/[OutOfS tateFuel], Null)), " _
& "IIf([TruckFuelGallons]<>0 , " _
& "IIf(IsNull([OutOfStateFue l]),[Miles Driven]/[T ruckFuelGa llons], " _
& "[MilesDriven]/([TruckFuel Gallons]+[ OutOfState Fuel])), " _
& "IIf(IsNull([OutOfStateFue l]),Null,I If([OutOfS tateFuel]< >0," _
& "[MilesDriven]/[OutOfState Fuel],Null )))),Null) " _
& strWhereClause & ";")
' db1.Execute ("UPDATE tbl_Haul_Data_Mileage " _
' & "SET tbl_Haul_Data_Mileage.MPG = " _
' & "IIf([MilesDriven]=0,0," _
' & "IIf([TruckFuelGallons]=0, 0," _
' & "[MilesDriven]/[TruckFuelG allons]))" _
& strWhereClause & ";")
db1.Execute ("UPDATE tbl_Haul_Data_Mileage " _
& "SET tbl_Haul_Data_Mileage.Home StateCode = " _
& "IIf([HomeStateCode]="""", Null,[Home StateCode] )" & strWhereClause & ";")
db1.Execute ("UPDATE tbl_Haul_Data_Mileage " _
& "SET tbl_Haul_Data_Mileage.OutS tateCode = " _
& "IIf([OutStateCode]="""",N ull,[OutSt ateCode])" & strWhereClause & ";")
frm2.Refresh
subCloseUp:
Set frm2 = Nothing
db1.Close
Set db1 = Nothing
Exit Sub
End Sub
Public Sub subErrorCheckUpdate(intCle arError As Integer) 'If multiple errors are on the record, only the last error found will show
GoSub subSetUp
GoSub subCheckLoop
GoSub subCloseUp
subSetUp:
Set db1 = CurrentDb
Set frm1 = Forms!frm_IFTA_Mileage_Ent ryEdit
Set frm2 = Forms!frm_IFTA_Mileage_Ent ryEdit.Chi ld41.Form
If intClearError = 0 Then
Call subClearErrorColumn ' db1.Execute ("UPDATE tbl_Haul_Data_Mileage SET ErrCode = NULL " & strWhereClause & ";")
End If
Return
subCheckLoop:
For intCntr1 = 1 To 10
Select Case intCntr1
Case 1: GoSub subCheckMilesDriven
Case 2: GoSub subCheckMPGLimits
Case 3: GoSub subCheckStateCodesOne
Case 4: GoSub subCheckStateCodesTwo
Case 5: GoSub subCheckStateCodesThree
Case 6: GoSub subCheckStateCodesFour
Case 7: GoSub subCheckStateCodesFive
Case 8: GoSub subCheckStateCodesSix
Case 9: GoSub subCheckBadInStates
Case 10: GoSub subCheckBadOutStates
End Select
GoSub subRunFilters
GoSub subAddErrCode
Next
Call subStowMileageFilter
Return
subRunFilters:
strWhereClause = " WHERE " & strDateRangeClause & " AND " & strBadGuyClause
Return
subAddErrCode:
Set rcst1 = Forms!frm_IFTA_Mileage_Ent ryEdit.Chi ld41.Form. RecordsetC lone
If rcst1.RecordCount <> 0 Then
db1.Execute ("UPDATE tbl_Haul_Data_Mileage SET ErrCode = " & intErrCode & " " & strWhereClause & ";")
End If
rcst1.Close
Set rcst1 = Nothing
Return
subCheckMilesDriven: 'Miles Driven Out of limits
strBadGuyClause = "((MilesDriven)>=" & frm1.txtHighMileageLimit & " OR " _
& "(MilesDriven)<=" & frm1.txtLowMileageLimit & ")"
intErrCode = 1
Return
subCheckMPGLimits: 'Miles per gallon out of limits
strBadGuyClause = "((MPG)>=" & frm1.txtHighMPGLimit & " OR " _
& "(MPG)<=" & frm1.txtLowMPGLimit & ")"
intErrCode = 2
Return
subCheckStateCodesOne: 'InStateCode cannot equal OutStateCode
strBadGuyClause = "(([HomeStateCode]=[OutSta teCode]))"
intErrCode = 3
Return
subCheckStateCodesTwo: 'If there is no InStateCode there can be no InStateMiles
strBadGuyClause = "(((tbl_Haul_Data_Mileage. InStateMil es)<>0) AND " _
& "((tbl_Haul_Data_Mileage.H omeStateCo de) Is Null))"
intErrCode = 4
Return
subCheckStateCodesThree: 'If there is no OutStateCode there can be no OutStateMiles
strBadGuyClause = "(((tbl_Haul_Data_Mileage. OutStateMi les)<>0) AND " _
& "((tbl_Haul_Data_Mileage.O utStateCod e) Is Null))"
intErrCode = 5
Return
subCheckStateCodesFour: 'If there is an InStateCode there must be InStateMiles
strBadGuyClause = "(((tbl_Haul_Data_Mileage. InStateMil es)=0) AND " _
& "((tbl_Haul_Data_Mileage.H omeStateCo de) Is Not Null))"
intErrCode = 6
Return
subCheckStateCodesFive: 'If there is an OutStateCode there must be OutStateMiles
strBadGuyClause = "(((tbl_Haul_Data_Mileage. OutStateMi les)=0) AND " _
& "((tbl_Haul_Data_Mileage.O utStateCod e) Is Not Null))"
intErrCode = 7
Return
subCheckStateCodesSix: 'Must be at least one State code
strBadGuyClause = "(((tbl_Haul_Data_Mileage. HomeStateC ode) Is Null) AND " _
& "((tbl_Haul_Data_Mileage.O utStateCod e) Is Null))"
intErrCode = 8
Return
subCheckBadInStates: 'Is InStateCode a state
Set rcst2 = db1.OpenRecordset("SELECT tbl_Haul_Data_Mileage.Home StateCode " _
& "FROM tbl_Haul_Data_Mileage " _
& "LEFT JOIN tblState " _
& "ON tbl_Haul_Data_Mileage.Home StateCode = tblState.StateAbbr " _
& "WHERE (((tblState.StateAbbr) Is Null));")
If rcst2.EOF And rcst2.BOF Then
Else
rcst2.MoveLast
If rcst2.RecordCount <> 0 Then
ReDim strBadStateArray(rcst2.Rec ordCount)
rcst2.MoveFirst
For intCntr2 = 1 To rcst2.RecordCount
If IsNull(rcst2!HomeStateCode ) Then
strBadStateArray(intCntr2) = "(tbl_Haul_Data_Mileage.Ho meStateCod e) Is Null "
Else
strBadStateArray(intCntr2) = "(tbl_Haul_Data_Mileage.Ho meStateCod e)='" & rcst2!HomeStateCode & " '"
End If
rcst2.MoveNext
Next
rcst2.Close
Set rcst2 = Nothing
For intCntr2 = 1 To UBound(strBadStateArray)
If intCntr2 = 1 Then
strBadGuyClause = strBadStateArray(intCntr2)
Else
strBadGuyClause = strBadGuyClause & " OR " & strBadStateArray(intCntr2)
End If
Next
strBadGuyClause = "((" & strBadGuyClause & "))"
intErrCode = 9
End If
End If
Return
subCheckBadOutStates: 'Is OutStateCode a state
Set rcst2 = db1.OpenRecordset("SELECT tbl_Haul_Data_Mileage.OutS tateCode " _
& "FROM tbl_Haul_Data_Mileage " _
& "LEFT JOIN tblState " _
& "ON tbl_Haul_Data_Mileage.OutS tateCode = tblState.StateAbbr " _
& "WHERE (((tbl_Haul_Data_Mileage.O utStateCod e) Is Not Null) " _
& "AND ((tblState.StateAbbr) Is Null));")
If rcst2.EOF And rcst2.BOF Then
Else
rcst2.MoveLast
If rcst2.RecordCount <> 0 Then
ReDim strBadStateArray(rcst2.Rec ordCount)
rcst2.MoveFirst
For intCntr2 = 1 To rcst2.RecordCount
strBadStateArray(intCntr2) = "(tbl_Haul_Data_Mileage.Ou tStateCode )='" & rcst2!OutStateCode & " '"
rcst2.MoveNext
Next
rcst2.Close
Set rcst2 = Nothing
For intCntr2 = 1 To UBound(strBadStateArray)
If intCntr2 = 1 Then
strBadGuyClause = strBadStateArray(intCntr2)
Else
strBadGuyClause = strBadGuyClause & " OR " & strBadStateArray(intCntr2)
End If
Next
strBadGuyClause = "((" & strBadGuyClause & "))"
intErrCode = 10
End If
End If
Return
subCloseUp:
ReDim strBadStateArray(0)
strBadStateArray(0) = ""
frm2.Filter = strDateRangeClause
Forms!frm_IFTA_Mileage_Ent ryEdit.Chi ld41.Form. Refresh 'needed to use an explicit reference here
Set frm1 = Nothing
Set frm2 = Nothing
db1.Close
Set db1 = Nothing
Exit Sub
ErrorThingy:
MsgBox "Too many Errors to check on in one shot"
GoSub subCloseUp
End Sub
Public Sub subFindGaps(intClearError As Integer)
Dim strRecID As String
Dim lngTruck As Long
Dim dteDate As Date
Dim lngHoldMiles As Long
GoSub subSetUp
GoSub subSetAnyNullsToZero
GoSub subProcess
GoSub subCloseUp
subSetUp:
Set db1 = CurrentDb
Set frm2 = Forms!frm_IFTA_Mileage_Ent ryEdit.Chi ld41.Form
Call subStowMileageFilter
If intClearError = 0 Then
Call subClearErrorColumn 'db1.Execute ("UPDATE tbl_Haul_Data_Mileage SET ErrCode = NULL " & strWhereClause & ";")
End If
Set rcst1 = db1.OpenRecordset( _
"SELECT RecordID, TruckId, HaulingDate, BeginningMiles, EndingMiles " _
& "FROM tbl_Haul_Data_Mileage " _
& strWhereClause _
& "ORDER BY TruckID, HaulingDate, BeginningMiles, EndingMiles")
Return
subSetAnyNullsToZero:
db1.Execute ("UPDATE tbl_Haul_Data_Mileage " _
& "SET tbl_Haul_Data_Mileage.Begi nningMiles = " _
& "IIf(IsNull([BeginningMile s]),0,[Beg inningMile s]), " _
& "tbl_Haul_Data_Mileage.End ingMiles = " _
& "IIf(IsNull([EndingMiles]) ,0,[Ending Miles])" & strWhereClause & ";")
Return
subProcess:
With rcst1
GoSub subNoMoRecords
rcst1.MoveFirst
GoSub subHoldTruck
rcst1.MoveNext
GoSub subNoMoRecords
Do Until rcst1.EOF
If lngTruck = !TruckId Then
If rcst1!BeginningMiles <> lngHoldMiles Then
GoSub subMarkRecord
End If
Else
GoSub subHoldTruck
End If
GoSub subHoldTruck
rcst1.MoveNext
Loop
End With
frm2.Refresh
Return
subHoldTruck:
lngTruck = rcst1!TruckId
lngHoldMiles = rcst1!EndingMiles
Return
subNoMoRecords:
If Not rcst1.EOF Or rcst1.BOF Then
Return
Else
GoSub subCloseUp
End If
Return
subMarkRecord:
db1.Execute ("UPDATE tbl_Haul_Data_Mileage SET ErrCode = 11 WHERE RecordID = '" & rcst1!RecordID & "';")
Return
subCloseUp:
lngTruck = 0
lngHoldMiles = 0
rcst1.Close
Set rcst1 = Nothing
db1.Close
Set db1 = Nothing
Set frm2 = Nothing
Exit Sub
End Sub
Public Sub subIsItANewMileageRecord() ''called from the forms current record event
GoSub subSetUp
GoSub subCheckRecord
GoSub subCloseUp
subSetUp:
Set frm1 = Forms!frm_IFTA_Mileage_Ent ryEdit.Chi ld41.Form
Return
subCheckRecord:
If frm1.NewRecord = True Then
frm1.RecordID = fnGenerateID("RecordID", "tbl_Haul_Data_Mileage")
End If
Return
subCloseUp:
Set frm1 = Nothing
Exit Sub
End Sub
Public Sub subClearErrorColumn()
Set db2 = CurrentDb
Call subStowMileageFilter
db2.Execute ("UPDATE tbl_Haul_Data_Mileage SET ErrCode = NULL " & strWhereClause & ";")
db2.Close
Set db2 = Nothing
Forms!frm_IFTA_Mileage_Ent ryEdit.Chi ld41.Form. Refresh
End Sub
'************************* ********** ********** ********** ********** ********** ********** ********** ********** ********** ****
'************************* ********** ********** ********** ********** ********** ********** ********** ********** ********** ****
'************************* ********** ********** ********** ********** ********** ********** ********** ********** ********** ****
'************************* ********** * Report and Processing Section ************************** ********** ****
'************************* ********** ********** ********** ********** ********** ********** ********** ********** ********** ****
'************************* ********** ********** ********** ********** ********** ********** ********** ********** ********** ****
'************************* ********** ********** ********** ********** ********** ********** ********** ********** ********** ****
Public Sub subProcessTotals()
Dim intOkToRunReportsSW As Integer
GoSub subrunChecks
GoSub subSetUp
GoSub subFindMarkedErrors
GoSub subCloseItUp
GoSub subOkToRunReports
Exit Sub
subrunChecks:
Call subClearErrorColumn
Call subUpDateStageOne
Call subErrorCheckUpdate(1)
Call subFindGaps(1)
Return
subSetUp:
Set db1 = CurrentDb
Set frm2 = Forms!frm_IFTA_Mileage_Ent ryEdit.Chi ld41.Form
intOkToRunReportsSW = 0
Return
subFindMarkedErrors: 'Error codes between 1,2, and 11 are allowed.
Set rcst1 = db1.OpenRecordset( _
"SELECT ErrCode " _
& "FROM tbl_Haul_Data_Mileage " _
& "WHERE (((tbl_Haul_Data_Mileage.E rrCode)>2 AND (tbl_Haul_Data_Mileage.Err Code)<11) " _
& "AND " & frm2.Filter & ");")
If rcst1.EOF Then
MsgBox "No Show Stopping Errors"
Else
rcst1.MoveLast
If MsgBox(rcst1.RecordCount & "Critical Errors Found." & vbCrLf _
& "Continue with Processing?", vbYesNo, "Errors Found") = vbNo Then
intOkToRunReportsSW = 1
Else
intOkToRunReportsSW = 0
'Create a note to place on report when this option is run, or error summary
End If
End If
Return
subOkToRunReports:
If intOkToRunReportsSW = 0 Then
Call subFillReportTables
Call SubStateMileageReportPivot
Call SubStateMileageReportPivot 2
Call SubStateMileageReportPivot 3
End If
Return
subCloseItUp:
rcst1.Close
db1.Close
Set rcst1 = Nothing
Set db1 = Nothing
Return
End Sub
Public Sub subFillReportTables()
GoSub subSetUp
GoSub subClearTempTables
GoSub subInsertStateTotals
GoSub subInsertTruckDetail
GoSub subCloseItUp
subSetUp:
Set db1 = CurrentDb
Return
subClearTempTables:
db1.Execute ("DELETE * FROM tbl_Haul_MilesByState;")
db1.Execute ("DELETE * FROM tbl_Haul_MilesByState2;")
db1.Execute ("DELETE * FROM tbl_Haul_TruckDetail;")
Return
subInsertStateTotals:
db1.Execute ("INSERT INTO tbl_Haul_MilesByState2 ( TruckID, State, MilesByState, GallonsByState ) " _
& "SELECT tbl_Haul_Data_Mileage.Truc kId, " _
& "tbl_Haul_Data_Mileage.Hom eStateCode , " _
& "Sum(tbl_Haul_Data_Mileage .InStateMi les) AS SumOfInStateMiles, " _
& "Sum(tbl_Haul_Data_Mileage .TruckFuel Gallons) AS SumOfTruckFuelGallons " _
& "FROM tbl_Haul_Data_Mileage " _
& strWhereClause _
& "GROUP BY tbl_Haul_Data_Mileage.Truc kId, " _
& " tbl_Haul_Data_Mileage.Home StateCode; ")
db1.Execute ("INSERT INTO tbl_Haul_MilesByState2 ( TruckID, State, MilesByState, GallonsByState ) " _
& "SELECT tbl_Haul_Data_Mileage.Truc kId, " _
& " tbl_Haul_Data_Mileage.OutS tateCode, " _
& "Sum(tbl_Haul_Data_Mileage .OutStateM iles) AS SumOfOutStateMiles, " _
& "Sum(tbl_Haul_Data_Mileage .OutOfStat eFuel) AS SumOfOutOfStateFuel " _
& "FROM tbl_Haul_Data_Mileage " _
& strWhereClause _
& "GROUP BY tbl_Haul_Data_Mileage.Truc kId, " _
& "tbl_Haul_Data_Mileage.Out StateCode " _
& "HAVING (((tbl_Haul_Data_Mileage.O utStateCod e) Is Not Null));")
db1.Execute ("INSERT INTO tbl_Haul_MilesByState ( State, TruckID, MilesByState, GallonsByState ) " _
& "SELECT tbl_Haul_MilesByState2.Sta te, " _
& " tbl_Haul_MilesByState2.Tru ckID, " _
& "Sum(tbl_Haul_MilesByState 2.MilesByS tate) AS SumOfMilesByState, " _
& "Sum(tbl_Haul_MilesByState 2.GallonsB yState) AS SumOfGallonsByState " _
& "FROM tbl_Haul_MilesByState2 " _
& "GROUP BY tbl_Haul_MilesByState2.Sta te, " _
& " tbl_Haul_MilesByState2.Tru ckID;")
'_________________________ __________ __________ __________ __________ __________ __________ __________ __________ __________
'_________________________ __________ __________ __________ __________ __________ __________ __________ ______
Return
subInsertTruckDetail:
db1.Execute ("INSERT INTO tbl_Haul_TruckDetail " _
& "( HaulingDate, TruckId, BeginningMiles, EndingMiles, DriverID, LastName, FirstName, " _
& "MilesDriven, TruckFuelGallons, ShopMilesSW, MPG, ErrCode, Description, OutOfStateFuel ) " _
& "SELECT tbl_Haul_Data_Mileage.Haul ingDate, " _
& "tbl_Haul_Data_Mileage.Tru ckId, tbl_Haul_Data_Mileage.Begi nningMiles , " _
& "tbl_Haul_Data_Mileage.End ingMiles, tbl_Haul_Data_Mileage.Driv erID, " _
& "tblDriver.LastName, tblDriver.FirstName, tbl_Haul_Data_Mileage.Mile sDriven, " _
& "tbl_Haul_Data_Mileage.Tru ckFuelGall ons, tbl_Haul_Data_Mileage.Shop MilesSW, " _
& "tbl_Haul_Data_Mileage.MPG , tbl_Haul_Data_Mileage.ErrC ode, " _
& "tbl_Ref_ErrCodes.Descript ion, tbl_Haul_Data_Mileage.OutO fStateFuel " _
& "FROM (tbl_Haul_Data_Mileage " _
& "LEFT JOIN tblDriver " _
& "ON tbl_Haul_Data_Mileage.Driv erID = tblDriver.DriverID) " _
& "LEFT JOIN tbl_Ref_ErrCodes " _
& "ON tbl_Haul_Data_Mileage.ErrC ode = tbl_Ref_ErrCodes.Errcode " _
& strWhereClause _
& "ORDER BY tbl_Haul_Data_Mileage.Haul ingDate, tbl_Haul_Data_Mileage.Truc kId, " _
& "tbl_Haul_Data_Mileage.Beg inningMile s, tbl_Haul_Data_Mileage.Endi ngMiles, " _
& "tbl_Haul_Data_Mileage.Dri verID;")
Return
subCloseItUp:
db1.Close
Set db1 = Nothing
Exit Sub
Return
End Sub
Public Sub SubStateMileageReportPivot () 'this Procsedure creates that blasted pivot report
Dim dbs As dao.Database
Dim rst As dao.Recordset
Dim qry As dao.QueryDef
Dim mRpt As Report
Dim ctr As Container
Dim doc As Document
Dim intDataX As Integer
Dim intDataY As Integer
Dim intLabelX As Integer
Dim intLabelY As Integer
Dim ctlText As Control
Dim ctlLabel As Control
Dim strPivot As String
Dim strName1 As String
Dim strName2 As String
Dim strName3 As String
Dim strRptName As Variant
Dim sngDiv As Single
Dim intCycle1 As Integer
Dim intCycle2 As Integer
GoSub subSetUpParameters
GoSub subsetUpStatements
GoSub subSetUpPivotTable
GoSub subSetupReportDimentions
GoSub subDeleteOldReport
GoSub subCreateReport
GoSub subFillControls
GoSub subCloseItUp
Exit Sub
subSetUpParameters:
strRptName = "rpt_Haul_Totals_State_Mil eage_Pivot "
strName3 = Format(DMin("[HaulingDate] ", "tbl_Haul_TruckDetail"), "dddd, mmmm dd, yyyy") 'Get high and low parameters
strName2 = Format(DMax("[HaulingDate] ", "tbl_Haul_TruckDetail"), "dddd, mmmm dd, yyyy")
strName1 = "TOTAL MILES PER STATE FOR PERIOD: " & vbCrLf & strName3 & vbCrLf & " -TO- " & vbCrLf & strName2
Return
subsetUpStatements:
strPivot = _
"TRANSFORM Sum(MilesByState) AS SumOfMilesByState " _
& "SELECT TruckID AS [Truck #], " _
& "Sum(MilesByState) AS [Total Miles] " _
& "FROM tbl_Haul_MilesByState " _
& "GROUP BY TruckID " _
& "PIVOT State;"
Return
subSetUpPivotTable:
Set dbs = CurrentDb 'Set DB
For Each qry In dbs.QueryDefs
If qry.Name = "qryStatePivot" Then 'Find and delete qry if exists
dbs.QueryDefs.Delete qry.Name
End If
Next
Set qry = dbs.CreateQueryDef("qrySta tePivot", strPivot) 'Create new one
Set rst = qry.OpenRecordset(dbOpenSn apshot) 'Set the new recordset
Return
subSetupReportDimentions:
Set ctr = dbs.Containers!Reports 'Set container Object
sngDiv = (1440 * 7.5) / (rst.Fields.Count) 'Find Increments from the rst fields count
If sngDiv <= (1440 * 0.56) Then
sngDiv = (1440 * 0.56)
End If
Return
subDeleteOldReport:
For Each doc In ctr.Documents 'Find and delete existing report
If doc.Name = strRptName Then
DoCmd.SetWarnings False
DoCmd.DeleteObject acReport, doc.Name
DoCmd.SetWarnings True
End If
Next doc
Return
subCreateReport:
Set mRpt = CreateReport(, "Rpt_VarTemplate") 'Use template and recordset to create report
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acHeader, "", "Report Date:" & vbCrLf & Date, 0, 0, (1440 * 7.5), (1440 * 0.1563)) 'Header Label
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acHeader, "", "Wilco Transportation LLC", 0, 0, (1440 * 7.5), (1440 * 0.1563)) 'Header Label
ctlLabel.Width = (1440 * 7.5)
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acHeader, "", strName1, 0, (1440 * 0.1563), (1440 * 7.5), (1440 * 0.5833)) 'Header Label
ctlLabel.Width = (1440 * 7.5)
ctlLabel.TextAlign = 2 'Center
Return
subFillControls:
'Header
intDataX = 0
For intCycle1 = 0 To rst.Fields.Count - 1
If intCycle1 <> 1 Then
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acPageHeader, "", rst.Fields(intCycle1).Name , intDataX, (1440 * 0.1563), sngDiv)
GoSub subAdjustBox
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
End If
Next
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acPageHeader, "", rst.Fields(1).Name, intDataX, (1440 * 0.1563), sngDiv) 'Move column(1) to last position, this is the totals columns
GoSub subAdjustBox
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
'detail
intDataX = 0
rst.MoveFirst
intCycle2 = intCycle2 + 1
Do Until rst.EOF
For intCycle1 = 0 To rst.Fields.Count - 1
If intCycle1 <> 1 Then
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acDetail, "", rst.Fields(intCycle1).Name , intDataX, (1440 * 0.1563) * (intCycle2 - 1), sngDiv)
If IsNull(rst.Fields(intCycle 1).Value) Then
ctlLabel.Caption = ""
Else
ctlLabel.Caption = rst.Fields(intCycle1).Valu e
End If
GoSub subAdjustBox
End If
Next
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acDetail, "", rst.Fields(1).Name, intDataX, (1440 * 0.1563) * (intCycle2 - 1), sngDiv) 'Move column(1) to last position, this is the totals columns
If IsNull(rst.Fields(1).Value ) Then
ctlLabel.Caption = ""
Else
ctlLabel.Caption = rst.Fields(1).Value
End If
GoSub subAdjustBox
rst.MoveNext
intCycle2 = intCycle2 + 1
intDataX = 0
Loop
'totals, still in detail
intDataX = 0
For intCycle1 = 0 To rst.Fields.Count - 1
If intCycle1 > 1 Then
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acDetail, "", DSum(rst.Fields(intCycle1) .Name, "qryStatePivot"), intDataX, (1440 * 0.1563) * (intCycle2 - 1), sngDiv)
GoSub subAdjustBox
ElseIf intCycle1 = 0 Then
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acDetail, "", "State Totals: ", intDataX, (1440 * 0.1563) * (intCycle2 - 1), sngDiv)
intDataX = 0
GoSub subAdjustBox
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
End If
Next
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acDetail, "", DSum("[" & rst.Fields(1).Name & "]", "qryStatePivot"), intDataX, (1440 * 0.1563) * (intCycle2 - 1), sngDiv)
GoSub subAdjustBox
Return
subAdjustBox:
ctlLabel.BorderStyle = 1
ctlLabel.TextAlign = 3 'Center
ctlLabel.Width = sngDiv
intDataX = intDataX + sngDiv
Return
subCloseItUp:
'MsgBox "Done"
DoCmd.Restore
DoCmd.Save acReport, mRpt.Name
DoCmd.Close acReport, mRpt.Name
DoCmd.SetWarnings False
DoCmd.Rename strRptName, acReport, "Report1"
DoCmd.SetWarnings True
DoCmd.Maximize
rst.Close
dbs.QueryDefs.Delete qry.Name
dbs.Close
Return
End Sub
Public Sub SubStateMileageReportPivot 2() 'this Procsedure creates that blasted pivot report
Dim dbs As dao.Database
Dim rst As dao.Recordset
Dim qry As dao.QueryDef
Dim mRpt As Report
Dim ctr As Container
Dim doc As Document
Dim intDataX As Integer
Dim intDataY As Integer
Dim intLabelX As Integer
Dim intLabelY As Integer
Dim ctlText As Control
Dim ctlLabel As Control
Dim strPivot As String
Dim strName1 As String
Dim strName2 As String
Dim strName3 As String
Dim strRptName As Variant
Dim sngDiv As Single
Dim intCycle1 As Integer
Dim intCycle2 As Integer
GoSub subSetUpParameters
GoSub subsetUpStatements
GoSub subSetUpPivotTable
GoSub subSetupReportDimentions
GoSub subDeleteOldReport
GoSub subCreateReport
GoSub subFillControls
GoSub subCloseItUp
Exit Sub
subSetUpParameters:
strRptName = "rpt_Haul_Totals_State_Mil eage_Pivot 2"
strName3 = Format(DMin("[HaulingDate] ", "tbl_Haul_TruckDetail"), "dddd, mmmm dd, yyyy") 'Get high and low parameters
strName2 = Format(DMax("[HaulingDate] ", "tbl_Haul_TruckDetail"), "dddd, mmmm dd, yyyy")
strName1 = "TOTAL MPG PER STATE FOR PERIOD: " & vbCrLf & strName3 & vbCrLf & " -TO- " & vbCrLf & strName2
Return
subsetUpStatements:
strPivot = _
"TRANSFORM Sum([milesDriven])/(IIF(is null(Sum([ TruckFuelG allons])), 0,Sum([Tru ckFuelGall ons])) " _
& "+ IIF(isnull(Sum([OutOfState Fuel])), 0,Sum([OutOfStateFuel]))) AS AvgOfMPGByState " _
& "SELECT tbl_Haul_TruckDetail.Truck ID AS [Truck #], " _
& "Sum([milesDriven])/(Sum([ TruckFuelG allons])+ Sum([OutOfStateFuel])) AS [Total MPG] " _
& "FROM tbl_Haul_MilesByState " _
& "LEFT JOIN tbl_Haul_TruckDetail " _
& "ON tbl_Haul_MilesByState.Truc kID = tbl_Haul_TruckDetail.Truck Id " _
& "GROUP BY tbl_Haul_TruckDetail.Truck ID " _
& "PIVOT tbl_Haul_MilesByState.Stat e; "
Return
subSetUpPivotTable:
Set dbs = CurrentDb 'Set DB
For Each qry In dbs.QueryDefs
If qry.Name = "qryStateMPGPivot" Then 'Find and delete qry if exists
dbs.QueryDefs.Delete qry.Name
End If
Next
Set qry = dbs.CreateQueryDef("qrySta teMPGPivot ", strPivot) 'Create new one
Set rst = qry.OpenRecordset(dbOpenSn apshot) 'Set the new recordset
Return
subSetupReportDimentions:
Set ctr = dbs.Containers!Reports 'Set container Object
sngDiv = (1440 * 7.5) / (rst.Fields.Count) 'Find Increments from the rst fields count
If sngDiv <= (1440 * 0.56) Then
sngDiv = (1440 * 0.56)
End If
Return
subDeleteOldReport:
For Each doc In ctr.Documents 'Find and delete existing report
If doc.Name = strRptName Then
DoCmd.SetWarnings False
DoCmd.DeleteObject acReport, doc.Name
DoCmd.SetWarnings True
End If
Next doc
Return
subCreateReport:
Set mRpt = CreateReport(, "Rpt_VarTemplate") 'Use template and recordset to create report
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acHeader, "", "Report Date:" & vbCrLf & Date, 0, 0, (1440 * 7.5), (1440 * 0.1563)) 'Header Label
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acHeader, "", "Wilco Transportation LLC", 0, 0, (1440 * 7.5), (1440 * 0.1563)) 'Header Label
ctlLabel.Width = (1440 * 7.5)
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acHeader, "", strName1, 0, (1440 * 0.1563), (1440 * 7.5), (1440 * 0.5833)) 'Header Label
ctlLabel.Width = (1440 * 7.5)
ctlLabel.TextAlign = 2 'Center
Return
subFillControls:
'Header
intDataX = 0
For intCycle1 = 0 To rst.Fields.Count - 1
If intCycle1 <> 1 Then
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acPageHeader, "", rst.Fields(intCycle1).Name , intDataX, (1440 * 0.1563), sngDiv)
GoSub subAdjustBox
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
End If
Next
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acPageHeader, "", rst.Fields(1).Name, intDataX, (1440 * 0.1563), sngDiv) 'Move column(1) to last position, this is the totals columns
GoSub subAdjustBox
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
'detail
intDataX = 0
rst.MoveFirst
intCycle2 = intCycle2 + 1
Do Until rst.EOF
For intCycle1 = 0 To rst.Fields.Count - 1
If intCycle1 <> 1 Then
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acDetail, "", rst.Fields(intCycle1).Name , intDataX, (1440 * 0.1563) * (intCycle2 - 1), sngDiv)
If IsNull(rst.Fields(intCycle 1).Value) Then
ctlLabel.Caption = ""
Else
If intCycle1 <> 0 Then
ctlLabel.Caption = Format(rst.Fields(intCycle 1).Value, "Standard")
Else
ctlLabel.Caption = rst.Fields(intCycle1).Valu e
End If
End If
GoSub subAdjustBox
End If
Next
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acDetail, "", rst.Fields(1).Name, intDataX, (1440 * 0.1563) * (intCycle2 - 1), sngDiv) 'Move column(1) to last position, this is the totals columns
If IsNull(rst.Fields(1).Value ) Then
ctlLabel.Caption = ""
Else
ctlLabel.Caption = Format(rst.Fields(1).Value , "Standard")
End If
GoSub subAdjustBox
rst.MoveNext
intCycle2 = intCycle2 + 1
intDataX = 0
Loop
'totals, still in detail
intDataX = 0
For intCycle1 = 0 To rst.Fields.Count - 1
If intCycle1 > 1 Then
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acDetail, "", Format(DLookup("Sum([Miles ByState])/ Sum([Gallo nsByState] )", "tbl_Haul_MilesByState", "[State]=""" & rst.Fields(intCycle1).Name & """"), "Standard"), intDataX, (1440 * 0.1563) * (intCycle2 - 1), sngDiv)
GoSub subAdjustBox
ElseIf intCycle1 = 0 Then
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acDetail, "", "State Totals: ", intDataX, (1440 * 0.1563) * (intCycle2 - 1), sngDiv)
intDataX = 0
GoSub subAdjustBox
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
End If
Next
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acDetail, "", Format(DLookup("Sum([Miles ByState])/ Sum([Gallo nsByState] )", "tbl_Haul_MilesByState"), "Standard"), intDataX, (1440 * 0.1563) * (intCycle2 - 1), sngDiv)
GoSub subAdjustBox
Return
subAdjustBox:
ctlLabel.BorderStyle = 1
ctlLabel.TextAlign = 3 'Center
ctlLabel.Width = sngDiv
intDataX = intDataX + sngDiv
Return
subCloseItUp:
'MsgBox "Done"
DoCmd.Restore
DoCmd.Save acReport, mRpt.Name
DoCmd.Close acReport, mRpt.Name
DoCmd.SetWarnings False
DoCmd.Rename strRptName, acReport, "Report1"
DoCmd.SetWarnings True
DoCmd.Maximize
rst.Close
dbs.QueryDefs.Delete qry.Name
dbs.Close
Return
End Sub
Public Sub SubStateMileageReportPivot 3() 'this Procsedure creates that blasted pivot report
Dim dbs As dao.Database
Dim rst As dao.Recordset
Dim qry As dao.QueryDef
Dim mRpt As Report
Dim ctr As Container
Dim doc As Document
Dim intDataX As Integer
Dim intDataY As Integer
Dim intLabelX As Integer
Dim intLabelY As Integer
Dim ctlText As Control
Dim ctlLabel As Control
Dim strPivot As String
Dim strName1 As String
Dim strName2 As String
Dim strName3 As String
Dim strRptName As Variant
Dim sngDiv As Single
Dim intCycle1 As Integer
Dim intCycle2 As Integer
GoSub subSetUpParameters
GoSub subsetUpStatements
GoSub subSetUpPivotTable
GoSub subSetupReportDimentions
GoSub subDeleteOldReport
GoSub subCreateReport
GoSub subFillControls
GoSub subCloseItUp
Exit Sub
subSetUpParameters:
strRptName = "rpt_Haul_Totals_State_Mil eage_Pivot 3"
strName3 = Format(DMin("[HaulingDate] ", "tbl_Haul_TruckDetail"), "dddd, mmmm dd, yyyy") 'Get high and low parameters
strName2 = Format(DMax("[HaulingDate] ", "tbl_Haul_TruckDetail"), "dddd, mmmm dd, yyyy")
strName1 = "TOTAL GALLONS PER STATE FOR PERIOD: " & vbCrLf & strName3 & vbCrLf & " -TO- " & vbCrLf & strName2
Return
subsetUpStatements:
strPivot = _
"TRANSFORM Sum(GallonsByState) AS SumOfGallonsByState " _
& "SELECT TruckID AS [Truck #], " _
& "Sum(GallonsByState) AS [Total Gallons] " _
& "FROM tbl_Haul_MilesByState " _
& "GROUP BY TruckID " _
& "PIVOT State;"
Return
subSetUpPivotTable:
Set dbs = CurrentDb 'Set DB
For Each qry In dbs.QueryDefs
If qry.Name = "qryStateGallonPivot" Then 'Find and delete qry if exists
dbs.QueryDefs.Delete qry.Name
End If
Next
Set qry = dbs.CreateQueryDef("qrySta teGallonPi vot", strPivot) 'Create new one
Set rst = qry.OpenRecordset(dbOpenSn apshot) 'Set the new recordset
Return
subSetupReportDimentions:
Set ctr = dbs.Containers!Reports 'Set container Object
sngDiv = (1440 * 7.5) / (rst.Fields.Count) 'Find Increments from the rst fields count
If sngDiv <= (1440 * 0.56) Then
sngDiv = (1440 * 0.56)
End If
Return
subDeleteOldReport:
For Each doc In ctr.Documents 'Find and delete existing report
If doc.Name = strRptName Then
DoCmd.SetWarnings False
DoCmd.DeleteObject acReport, doc.Name
DoCmd.SetWarnings True
End If
Next doc
Return
subCreateReport:
Set mRpt = CreateReport(, "Rpt_VarTemplate") 'Use template and recordset to create report
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acHeader, "", "Report Date:" & vbCrLf & Date, 0, 0, (1440 * 7.5), (1440 * 0.1563)) 'Header Label
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acHeader, "", "Wilco Transportation LLC", 0, 0, (1440 * 7.5), (1440 * 0.1563)) 'Header Label
ctlLabel.Width = (1440 * 7.5)
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acHeader, "", strName1, 0, (1440 * 0.1563), (1440 * 7.5), (1440 * 0.5833)) 'Header Label
ctlLabel.Width = (1440 * 7.5)
ctlLabel.TextAlign = 2 'Center
Return
subFillControls:
'Header
intDataX = 0
For intCycle1 = 0 To rst.Fields.Count - 1
If intCycle1 <> 1 Then
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acPageHeader, "", rst.Fields(intCycle1).Name , intDataX, (1440 * 0.1563), sngDiv)
GoSub subAdjustBox
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
End If
Next
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acPageHeader, "", rst.Fields(1).Name, intDataX, (1440 * 0.1563), sngDiv) 'Move column(1) to last position, this is the totals columns
GoSub subAdjustBox
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
'detail
intDataX = 0
rst.MoveFirst
intCycle2 = intCycle2 + 1
Do Until rst.EOF
For intCycle1 = 0 To rst.Fields.Count - 1
If intCycle1 <> 1 Then
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acDetail, "", rst.Fields(intCycle1).Name , intDataX, (1440 * 0.1563) * (intCycle2 - 1), sngDiv)
If IsNull(rst.Fields(intCycle 1).Value) Then
ctlLabel.Caption = ""
Else
ctlLabel.Caption = rst.Fields(intCycle1).Valu e
End If
GoSub subAdjustBox
End If
Next
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acDetail, "", rst.Fields(1).Name, intDataX, (1440 * 0.1563) * (intCycle2 - 1), sngDiv) 'Move column(1) to last position, this is the totals columns
If IsNull(rst.Fields(1).Value ) Then
ctlLabel.Caption = ""
Else
ctlLabel.Caption = rst.Fields(1).Value
End If
GoSub subAdjustBox
rst.MoveNext
intCycle2 = intCycle2 + 1
intDataX = 0
Loop
'totals, still in detail
intDataX = 0
For intCycle1 = 0 To rst.Fields.Count - 1
If intCycle1 > 1 Then
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acDetail, "", DSum(rst.Fields(intCycle1) .Name, "qryStateGallonPivot"), intDataX, (1440 * 0.1563) * (intCycle2 - 1), sngDiv)
GoSub subAdjustBox
ElseIf intCycle1 = 0 Then
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acDetail, "", "State Totals: ", intDataX, (1440 * 0.1563) * (intCycle2 - 1), sngDiv)
intDataX = 0
GoSub subAdjustBox
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
End If
Next
Set ctlLabel = CreateReportControl(mRpt.N ame, acLabel, acDetail, "", DSum("[" & rst.Fields(1).Name & "]", "qryStateGallonPivot"), intDataX, (1440 * 0.1563) * (intCycle2 - 1), sngDiv)
GoSub subAdjustBox
Return
subAdjustBox:
ctlLabel.BorderStyle = 1
ctlLabel.TextAlign = 3 'Center
ctlLabel.Width = sngDiv
intDataX = intDataX + sngDiv
Return
subCloseItUp:
'MsgBox "Done"
DoCmd.Restore
DoCmd.Save acReport, mRpt.Name
DoCmd.Close acReport, mRpt.Name
DoCmd.SetWarnings False
DoCmd.Rename strRptName, acReport, "Report1"
DoCmd.SetWarnings True
DoCmd.Maximize
rst.Close
dbs.QueryDefs.Delete qry.Name
dbs.Close
Return
End Sub
Public Sub subPrintMileageReports()
DoCmd.OpenReport "rpt_Haul_Detail_Truck_Mil eage", acViewNormal
DoCmd.OpenReport "rpt_Haul_Totals_State_Mil eage_Pivot ", acViewNormal
DoCmd.OpenReport "rpt_Haul_Totals_State_Mil eage_Pivot 2", acViewNormal
DoCmd.OpenReport "rpt_Haul_Totals_State_Mil eage_Pivot 3", acViewNormal
End Sub
Public Sub subErrorList()
GoSub subSetUp
GoSub subProcess
GoSub subDisplay
GoSub subCloseItUp
Exit Sub
subSetUp:
strMessage = ""
Set db1 = CurrentDb
Set rcst1 = db1.OpenRecordset("SELECT Errcode, Description FROM tbl_Ref_ErrCodes;")
Return
subProcess:
With rcst1
rcst1.MoveFirst
Do Until .EOF
strMessage = strMessage & Space(2 - Len(rcst1!ErrCode)) & rcst1!ErrCode _
& " - " & rcst1!Description & vbCrLf
rcst1.MoveNext
Loop
End With
Return
subDisplay:
MsgBox strMessage
Return
subCloseItUp:
rcst1.Close
db1.Close
Set rcst1 = Nothing
Set db1 = Nothing
Return
End Sub
'
' InStateCode cannot equal OutStateCode 'Done
' If there is no InStateCode there can be no InStateMiles 'Done
' If there is no OutStateCode there can be no OutStateMiles 'Done
' If there is an InStateCode there must be InStateMiles 'Done
' If there is an OutStateCode there must be OutStateMiles 'Done
' Must be at least one State code 'Done
' Is InStateCode a state 'done
' Is OutStateCode a state 'done
'If multiple errors are on the record, only the last error found will show
'Set rcst1 = db1.OpenRecordset( _
' "SELECT HomeStateCode, OutStateCode, " _
' & "Sum(tbl_Haul_Data_Mileage .InStateMi les) AS SumOfInStateMiles, " _
' & "Sum(tbl_Haul_Data_Mileage .OutStateM iles) AS SumOfOutStateMiles, " _
' & "Sum(tbl_Haul_Data_Mileage .MilesDriv en) AS SumOfMilesDriven " _
' & "FROM tbl_Haul_Data_Mileage " _
' & "WHERE (((tbl_Haul_Data_Mileage.H aulingDate ) >= #1/1/2003# " _
' & "And (tbl_Haul_Data_Mileage.Hau lingDate) <= #1/31/2003#)) " _
' & "GROUP BY tbl_Haul_Data_Mileage.Home StateCode, tbl_Haul_Data_Mileage.OutS tateCode;" )
'db1.Execute ("INSERT INTO tbl_Haul_MilesByState ( State, MilesByState ) " _
' & "SELECT tbl_Haul_Data_Mileage.Home StateCode, " _
' & "Sum(tbl_Haul_Data_Mileage .InStateMi les) AS SumOfInStateMiles " _
' & "FROM tbl_Haul_Data_Mileage " _
' & "WHERE (((tbl_Haul_Data_Mileage.H aulingDate ) >= #1/1/2003# " _
' & "And (tbl_Haul_Data_Mileage.Hau lingDate) <= #1/31/2003#)) " _
' & "GROUP BY tbl_Haul_Data_Mileage.Home StateCode; ")
'
'db1.Execute ("INSERT INTO tbl_Haul_MilesByState ( State, MilesByState ) " _
' & "SELECT tbl_Haul_Data_Mileage.OutS tateCode, " _
' & "Sum(tbl_Haul_Data_Mileage .OutStateM iles) AS SumOfOutStateMiles " _
' & "FROM tbl_Haul_Data_Mileage " _
' & "WHERE (((tbl_Haul_Data_Mileage.H aulingDate ) >= #1/1/2003# " _
' & "And (tbl_Haul_Data_Mileage.Hau lingDate) <= #1/31/2003#)) " _
' & "GROUP BY tbl_Haul_Data_Mileage.OutS tateCode " _
' & "HAVING (((tbl_Haul_Data_Mileage.O utStateCod e) Is Not Null));")
'Last months begin and end dates
' frm1.TxtBegin.Value = Format((DateAdd("m", -1, Date) - _
' Day(DateAdd("m", -1, Date))) + 1, "mm/dd/yy")
' frm1.TxtEnd.Value = Format(Date - Day(Date), "Short Date")
'Don't toss out just yet. This sub found in procedure subErrorCheckUpdate
'subRunFilters:
' If strBadGuyClause = "" Then
' 'frm2.Filter = strDateRangeClause
' Else
' On Error GoTo ErrorThingy
'
' frm2.Filter = strDateRangeClause & " AND " & strBadGuyClause
' End If
' strBadGuyClause = ""
' Call subStowMileageFilter
'db1.Execute ("INSERT INTO tbl_Haul_MilesByState2 ( TruckID, State, MilesByState ) " _
' & "SELECT tbl_Haul_Data_Mileage.Truc kId, " _
' & "tbl_Haul_Data_Mileage.Hom eStateCode , " _
' & "Sum(tbl_Haul_Data_Mileage .InStateMi les) AS SumOfInStateMiles " _
' & "FROM tbl_Haul_Data_Mileage " _
' & strWhereClause _
' & "GROUP BY tbl_Haul_Data_Mileage.Truc kId, " _
' & "tbl_Haul_Data_Mileage.Hom eStateCode ;")
'
'db1.Execute ("INSERT INTO tbl_Haul_MilesByState2 ( TruckID, State, GallonsByState ) " _
' & "SELECT tbl_Haul_Data_Mileage.Truc kId, " _
' & "tbl_Haul_Data_Mileage.Hom eStateCode , " _
' & "Sum(tbl_Haul_Data_Mileage .TruckFuel Gallons) AS SumOfTruckFuelGallons " _
' & "FROM tbl_Haul_Data_Mileage " _
' & strWhereClause _
' & "GROUP BY tbl_Haul_Data_Mileage.Truc kId, " _
' & "tbl_Haul_Data_Mileage.Hom eStateCode , " _
' & "tbl_Haul_Data_Mileage.Out StateCode " _
' & "HAVING (((tbl_Haul_Data_Mileage.O utStateCod e) Is Null));")
'
'db1.Execute ("INSERT INTO tbl_Haul_MilesByState2 ( TruckID, MilesByState, State ) " _
' & "SELECT tbl_Haul_Data_Mileage.Truc kId, " _
' & "Sum(tbl_Haul_Data_Mileage .OutStateM iles) AS SumOfOutStateMiles, " _
' & "tbl_Haul_Data_Mileage.Out StateCode " _
' & "FROM tbl_Haul_Data_Mileage " _
' & strWhereClause _
' & "GROUP BY tbl_Haul_Data_Mileage.Truc kId, " _
' & "tbl_Haul_Data_Mileage.Out StateCode " _
' & "HAVING (((tbl_Haul_Data_Mileage.O utStateCod e) Is Not Null));")
'
'db1.Execute ("INSERT INTO tbl_Haul_MilesByState2 ( TruckID, GallonsByState, State ) " _
' & "SELECT tbl_Haul_Data_Mileage.Truc kId, " _
' & "Sum(tbl_Haul_Data_Mileage .TruckFuel Gallons) AS SumOfTruckFuelGallons, " _
' & "tbl_Haul_Data_Mileage.Out StateCode " _
' & "FROM tbl_Haul_Data_Mileage " _
' & strWhereClause _
' & "GROUP BY tbl_Haul_Data_Mileage.Truc kId, " _
' & "tbl_Haul_Data_Mileage.Out StateCode " _
' & "HAVING (((tbl_Haul_Data_Mileage.O utStateCod e) Is Not Null));")
'
'db1.Execute ("INSERT INTO tbl_Haul_MilesByState ( TruckID, State, MilesByState, GallonsByState ) " _
' & "SELECT tbl_Haul_MilesByState2.Tru ckID, " _
' & "tbl_Haul_MilesByState2.St ate, " _
' & "Sum(tbl_Haul_MilesByState 2.MilesByS tate) AS SumOfMilesByState, " _
' & "Sum(tbl_Haul_MilesByState 2.GallonsB yState) AS SumOfGallonsByState " _
' & "FROM tbl_Haul_MilesByState2 " _
' & "GROUP BY tbl_Haul_MilesByState2.Tru ckID, " _
' & "tbl_Haul_MilesByState2.St ate " _
' & "ORDER BY tbl_Haul_MilesByState2.Tru ckID, " _
' & "tbl_Haul_MilesByState2.St ate;")
'
'
' '_________________________ __________ __________ __________ __________ __________ __________ __________ __________ ___
'
'
'
'' db1.Execute ("INSERT INTO tbl_Haul_MilesByState ( State, TruckId, MilesByState, MPGByState, GallonsByState ) " _
'' & "SELECT HomeStateCode, TruckId, " _
'' & "Sum(tbl_Haul_Data_Mileage .InStateMi les) AS SumOfInStateMiles, " _
'' & "SumOfInStateMiles / SumOfTruckFuelGallons AS AvgOfMPG, " _
'' & "Sum(tbl_Haul_Data_Mileage .TruckFuel Gallons) AS SumOfTruckFuelGallons " _
'' & "FROM tbl_Haul_Data_Mileage " _
'' & strWhereClause _
'' & "GROUP BY tbl_Haul_Data_Mileage.Home StateCode, " _
'' & "tbl_Haul_Data_Mileage.Tru ckId, " _
'' & "tbl_Haul_Data_Mileage.Out StateCode " _
'' & "HAVING (((tbl_Haul_Data_Mileage.O utStateCod e) Is Null));")
''
'' db1.Execute ("INSERT INTO tbl_Haul_MilesByState ( State, TruckId, MilesByState, MPGByState, GallonsByState ) " _
'' & "SELECT OutStateCode, TruckId," _
'' & "Sum(OutStateMiles) AS SumOfOutStateMiles, " _
'' & "SumOfOutStateMiles / SumOfTruckGallons AS AvgOfMPG, " _
'' & "Sum(TruckFuelGallons) AS SumOfTruckGallons " _
'' & "FROM tbl_Haul_Data_Mileage " _
'' & strWhereClause _
'' & "GROUP BY OutStateCode, TruckId " _
'' & "HAVING (((OutStateCode) Is Not Null));")
Option Compare Database
Option Explicit
Dim db1 As dao.Database
Dim db2 As dao.Database
Dim rcst1 As dao.Recordset
Dim rcst2 As dao.Recordset
Dim frm1 As Form 'Use frm1a and frm2a so we don't inadvertantly
Dim frm2 As Form 'kill a reference by making an outside procedure call
Dim frm1a As Form
Dim frm2a As Form
Dim strWhereClause As String
Dim strFilterClause As String
Dim strDateRangeClause As String
Dim strMessage As String
Dim strBadStateArray() As String
Dim strBadGuyClause As String
Dim strOrderByClause As String
Dim intNewMRecID As Integer
Dim intErrCode As Integer
Dim intCntr1 As Integer
Dim intCntr2 As Integer
Public Sub subGetStartUpParameters()
GoSub subSetUp
GoSub subGetMileageLimits
GoSub subGetCurrentMonth
GoSub subCloseUp
subSetUp:
Set frm1 = Forms!frm_IFTA_Mileage_Ent
Return
subGetMileageLimits:
frm1.txtHighMileageLimit = DLookup("[HighMileageFacto
frm1.txtLowMileageLimit = DLookup("[LowMileageFactor
frm1.txtHighMPGLimit = DLookup("[HighMPGFactor]",
frm1.txtLowMPGLimit = DLookup("[LowMPGFactor]", "tbl_Ref_Mileage_Factors")
Return
subGetCurrentMonth:
frm1.TxtBegin.Value = Format((DateAdd("d", -Day(Date) + 1, Date)), "mm/dd/yy") 'First day of the current month
frm1.TxtEnd.Value = Format(Date, "mm/dd/yy") 'Current Day
Call subSetMileageRange
Return
subCloseUp:
Set frm1 = Nothing
Exit Sub
End Sub
Public Sub subSetMileageRange()
Dim strMsg As String
Dim strBegin As String
Dim strEnd As String
GoSub subSetUp
GoSub subCheckDates
GoSub subRunFilter
GoSub subCloseUp
subSetUp:
strDateRangeClause = ""
Set frm1 = Forms!frm_IFTA_Mileage_Ent
Set frm2 = Forms!frm_IFTA_Mileage_Ent
Return
subCheckDates:
If Not IsDate(frm1.TxtBegin) Then
strMsg = "-Begin Date- is not a date"
Else
strBegin = frm1.TxtBegin
End If
If Not IsDate(frm1.TxtEnd) Then
strMsg = strMsg & vbCrLf & "-End Date- is not a date"
Else
strEnd = frm1.TxtEnd
End If
If strMsg <> "" Then
MsgBox strMsg & vbCrLf & strBegin & strEnd
GoSub subCloseUp
End If
Return
subRunFilter:
strDateRangeClause = " ((HaulingDate)>=#" & strBegin & "# And (HaulingDate)<=#" & strEnd & "#)"
frm2.FilterOn = True
frm2.Filter = strDateRangeClause
Call subStowMileageFilter
Return
subCloseUp:
Set frm1 = Nothing
Set frm2 = Nothing
Exit Sub
End Sub
Public Sub subSortMileage()
GoSub subSetUp
GoSub subRunFilter
GoSub subCloseUp
subSetUp:
Set frm2 = Forms!frm_IFTA_Mileage_Ent
strOrderByClause = "TruckID, HaulingDate, BeginningMiles, EndingMiles"
Return
subRunFilter:
frm2.OrderByOn = True
frm2.OrderBy = strOrderByClause
Return
subCloseUp:
Set frm2 = Nothing
Exit Sub
End Sub
Public Sub subStowMileageFilter()
Set frm1a = Forms!frm_IFTA_Mileage_Ent
Set frm2a = Forms!frm_IFTA_Mileage_Ent
strWhereClause = " WHERE " & frm2a.Filter
frm1a.Label14.Caption = frm2a.Filter
Set frm1a = Nothing
Set frm2a = Nothing
End Sub
Public Sub subUpDateStageOne() 'Update MilesDriven, InStateMiles, MPG,
GoSub subSetUp 'Set empty strings to null so they can be tested on Null later
GoSub subUpdate
GoSub subCloseUp
subSetUp:
Set db1 = CurrentDb
Set frm2 = Forms!frm_IFTA_Mileage_Ent
Return
subUpdate:
db1.Execute ("UPDATE tbl_Haul_Data_Mileage " _
& "SET tbl_Haul_Data_Mileage.Begi
& "IIf(IsNull([BeginningMile
& "tbl_Haul_Data_Mileage.End
& "IIf(IsNull([EndingMiles])
& "tbl_Haul_Data_Mileage.InS
& "IIf(IsNull([InStateMiles]
& "tbl_Haul_Data_Mileage.Out
& "IIf(IsNull([OutStateMiles
db1.Execute ("UPDATE tbl_Haul_Data_Mileage " _
& "SET tbl_Haul_Data_Mileage.Mile
& "([EndingMiles]-[Beginning
db1.Execute ("UPDATE tbl_Haul_Data_Mileage " _
& "SET tbl_Haul_Data_Mileage.InSt
& "([MilesDriven]-[OutStateM
db1.Execute ("UPDATE tbl_Haul_Data_Mileage " _
& "SET tbl_Haul_Data_Mileage.MPG = " _
& "IIf([MilesDriven]<>0, " _
& "IIf(IsNull([TruckFuelGall
& "IIf(IsNull([OutOfStateFue
& "IIf([OutOfStateFuel]<>0,[
& "IIf([TruckFuelGallons]<>0
& "IIf(IsNull([OutOfStateFue
& "[MilesDriven]/([TruckFuel
& "IIf(IsNull([OutOfStateFue
& "[MilesDriven]/[OutOfState
& strWhereClause & ";")
' db1.Execute ("UPDATE tbl_Haul_Data_Mileage " _
' & "SET tbl_Haul_Data_Mileage.MPG = " _
' & "IIf([MilesDriven]=0,0," _
' & "IIf([TruckFuelGallons]=0,
' & "[MilesDriven]/[TruckFuelG
& strWhereClause & ";")
db1.Execute ("UPDATE tbl_Haul_Data_Mileage " _
& "SET tbl_Haul_Data_Mileage.Home
& "IIf([HomeStateCode]="""",
db1.Execute ("UPDATE tbl_Haul_Data_Mileage " _
& "SET tbl_Haul_Data_Mileage.OutS
& "IIf([OutStateCode]="""",N
frm2.Refresh
subCloseUp:
Set frm2 = Nothing
db1.Close
Set db1 = Nothing
Exit Sub
End Sub
Public Sub subErrorCheckUpdate(intCle
GoSub subSetUp
GoSub subCheckLoop
GoSub subCloseUp
subSetUp:
Set db1 = CurrentDb
Set frm1 = Forms!frm_IFTA_Mileage_Ent
Set frm2 = Forms!frm_IFTA_Mileage_Ent
If intClearError = 0 Then
Call subClearErrorColumn ' db1.Execute ("UPDATE tbl_Haul_Data_Mileage SET ErrCode = NULL " & strWhereClause & ";")
End If
Return
subCheckLoop:
For intCntr1 = 1 To 10
Select Case intCntr1
Case 1: GoSub subCheckMilesDriven
Case 2: GoSub subCheckMPGLimits
Case 3: GoSub subCheckStateCodesOne
Case 4: GoSub subCheckStateCodesTwo
Case 5: GoSub subCheckStateCodesThree
Case 6: GoSub subCheckStateCodesFour
Case 7: GoSub subCheckStateCodesFive
Case 8: GoSub subCheckStateCodesSix
Case 9: GoSub subCheckBadInStates
Case 10: GoSub subCheckBadOutStates
End Select
GoSub subRunFilters
GoSub subAddErrCode
Next
Call subStowMileageFilter
Return
subRunFilters:
strWhereClause = " WHERE " & strDateRangeClause & " AND " & strBadGuyClause
Return
subAddErrCode:
Set rcst1 = Forms!frm_IFTA_Mileage_Ent
If rcst1.RecordCount <> 0 Then
db1.Execute ("UPDATE tbl_Haul_Data_Mileage SET ErrCode = " & intErrCode & " " & strWhereClause & ";")
End If
rcst1.Close
Set rcst1 = Nothing
Return
subCheckMilesDriven: 'Miles Driven Out of limits
strBadGuyClause = "((MilesDriven)>=" & frm1.txtHighMileageLimit & " OR " _
& "(MilesDriven)<=" & frm1.txtLowMileageLimit & ")"
intErrCode = 1
Return
subCheckMPGLimits: 'Miles per gallon out of limits
strBadGuyClause = "((MPG)>=" & frm1.txtHighMPGLimit & " OR " _
& "(MPG)<=" & frm1.txtLowMPGLimit & ")"
intErrCode = 2
Return
subCheckStateCodesOne: 'InStateCode cannot equal OutStateCode
strBadGuyClause = "(([HomeStateCode]=[OutSta
intErrCode = 3
Return
subCheckStateCodesTwo: 'If there is no InStateCode there can be no InStateMiles
strBadGuyClause = "(((tbl_Haul_Data_Mileage.
& "((tbl_Haul_Data_Mileage.H
intErrCode = 4
Return
subCheckStateCodesThree: 'If there is no OutStateCode there can be no OutStateMiles
strBadGuyClause = "(((tbl_Haul_Data_Mileage.
& "((tbl_Haul_Data_Mileage.O
intErrCode = 5
Return
subCheckStateCodesFour: 'If there is an InStateCode there must be InStateMiles
strBadGuyClause = "(((tbl_Haul_Data_Mileage.
& "((tbl_Haul_Data_Mileage.H
intErrCode = 6
Return
subCheckStateCodesFive: 'If there is an OutStateCode there must be OutStateMiles
strBadGuyClause = "(((tbl_Haul_Data_Mileage.
& "((tbl_Haul_Data_Mileage.O
intErrCode = 7
Return
subCheckStateCodesSix: 'Must be at least one State code
strBadGuyClause = "(((tbl_Haul_Data_Mileage.
& "((tbl_Haul_Data_Mileage.O
intErrCode = 8
Return
subCheckBadInStates: 'Is InStateCode a state
Set rcst2 = db1.OpenRecordset("SELECT tbl_Haul_Data_Mileage.Home
& "FROM tbl_Haul_Data_Mileage " _
& "LEFT JOIN tblState " _
& "ON tbl_Haul_Data_Mileage.Home
& "WHERE (((tblState.StateAbbr) Is Null));")
If rcst2.EOF And rcst2.BOF Then
Else
rcst2.MoveLast
If rcst2.RecordCount <> 0 Then
ReDim strBadStateArray(rcst2.Rec
rcst2.MoveFirst
For intCntr2 = 1 To rcst2.RecordCount
If IsNull(rcst2!HomeStateCode
strBadStateArray(intCntr2)
Else
strBadStateArray(intCntr2)
End If
rcst2.MoveNext
Next
rcst2.Close
Set rcst2 = Nothing
For intCntr2 = 1 To UBound(strBadStateArray)
If intCntr2 = 1 Then
strBadGuyClause = strBadStateArray(intCntr2)
Else
strBadGuyClause = strBadGuyClause & " OR " & strBadStateArray(intCntr2)
End If
Next
strBadGuyClause = "((" & strBadGuyClause & "))"
intErrCode = 9
End If
End If
Return
subCheckBadOutStates: 'Is OutStateCode a state
Set rcst2 = db1.OpenRecordset("SELECT tbl_Haul_Data_Mileage.OutS
& "FROM tbl_Haul_Data_Mileage " _
& "LEFT JOIN tblState " _
& "ON tbl_Haul_Data_Mileage.OutS
& "WHERE (((tbl_Haul_Data_Mileage.O
& "AND ((tblState.StateAbbr) Is Null));")
If rcst2.EOF And rcst2.BOF Then
Else
rcst2.MoveLast
If rcst2.RecordCount <> 0 Then
ReDim strBadStateArray(rcst2.Rec
rcst2.MoveFirst
For intCntr2 = 1 To rcst2.RecordCount
strBadStateArray(intCntr2)
rcst2.MoveNext
Next
rcst2.Close
Set rcst2 = Nothing
For intCntr2 = 1 To UBound(strBadStateArray)
If intCntr2 = 1 Then
strBadGuyClause = strBadStateArray(intCntr2)
Else
strBadGuyClause = strBadGuyClause & " OR " & strBadStateArray(intCntr2)
End If
Next
strBadGuyClause = "((" & strBadGuyClause & "))"
intErrCode = 10
End If
End If
Return
subCloseUp:
ReDim strBadStateArray(0)
strBadStateArray(0) = ""
frm2.Filter = strDateRangeClause
Forms!frm_IFTA_Mileage_Ent
Set frm1 = Nothing
Set frm2 = Nothing
db1.Close
Set db1 = Nothing
Exit Sub
ErrorThingy:
MsgBox "Too many Errors to check on in one shot"
GoSub subCloseUp
End Sub
Public Sub subFindGaps(intClearError As Integer)
Dim strRecID As String
Dim lngTruck As Long
Dim dteDate As Date
Dim lngHoldMiles As Long
GoSub subSetUp
GoSub subSetAnyNullsToZero
GoSub subProcess
GoSub subCloseUp
subSetUp:
Set db1 = CurrentDb
Set frm2 = Forms!frm_IFTA_Mileage_Ent
Call subStowMileageFilter
If intClearError = 0 Then
Call subClearErrorColumn 'db1.Execute ("UPDATE tbl_Haul_Data_Mileage SET ErrCode = NULL " & strWhereClause & ";")
End If
Set rcst1 = db1.OpenRecordset( _
"SELECT RecordID, TruckId, HaulingDate, BeginningMiles, EndingMiles " _
& "FROM tbl_Haul_Data_Mileage " _
& strWhereClause _
& "ORDER BY TruckID, HaulingDate, BeginningMiles, EndingMiles")
Return
subSetAnyNullsToZero:
db1.Execute ("UPDATE tbl_Haul_Data_Mileage " _
& "SET tbl_Haul_Data_Mileage.Begi
& "IIf(IsNull([BeginningMile
& "tbl_Haul_Data_Mileage.End
& "IIf(IsNull([EndingMiles])
Return
subProcess:
With rcst1
GoSub subNoMoRecords
rcst1.MoveFirst
GoSub subHoldTruck
rcst1.MoveNext
GoSub subNoMoRecords
Do Until rcst1.EOF
If lngTruck = !TruckId Then
If rcst1!BeginningMiles <> lngHoldMiles Then
GoSub subMarkRecord
End If
Else
GoSub subHoldTruck
End If
GoSub subHoldTruck
rcst1.MoveNext
Loop
End With
frm2.Refresh
Return
subHoldTruck:
lngTruck = rcst1!TruckId
lngHoldMiles = rcst1!EndingMiles
Return
subNoMoRecords:
If Not rcst1.EOF Or rcst1.BOF Then
Return
Else
GoSub subCloseUp
End If
Return
subMarkRecord:
db1.Execute ("UPDATE tbl_Haul_Data_Mileage SET ErrCode = 11 WHERE RecordID = '" & rcst1!RecordID & "';")
Return
subCloseUp:
lngTruck = 0
lngHoldMiles = 0
rcst1.Close
Set rcst1 = Nothing
db1.Close
Set db1 = Nothing
Set frm2 = Nothing
Exit Sub
End Sub
Public Sub subIsItANewMileageRecord()
GoSub subSetUp
GoSub subCheckRecord
GoSub subCloseUp
subSetUp:
Set frm1 = Forms!frm_IFTA_Mileage_Ent
Return
subCheckRecord:
If frm1.NewRecord = True Then
frm1.RecordID = fnGenerateID("RecordID", "tbl_Haul_Data_Mileage")
End If
Return
subCloseUp:
Set frm1 = Nothing
Exit Sub
End Sub
Public Sub subClearErrorColumn()
Set db2 = CurrentDb
Call subStowMileageFilter
db2.Execute ("UPDATE tbl_Haul_Data_Mileage SET ErrCode = NULL " & strWhereClause & ";")
db2.Close
Set db2 = Nothing
Forms!frm_IFTA_Mileage_Ent
End Sub
'*************************
'*************************
'*************************
'*************************
'*************************
'*************************
'*************************
Public Sub subProcessTotals()
Dim intOkToRunReportsSW As Integer
GoSub subrunChecks
GoSub subSetUp
GoSub subFindMarkedErrors
GoSub subCloseItUp
GoSub subOkToRunReports
Exit Sub
subrunChecks:
Call subClearErrorColumn
Call subUpDateStageOne
Call subErrorCheckUpdate(1)
Call subFindGaps(1)
Return
subSetUp:
Set db1 = CurrentDb
Set frm2 = Forms!frm_IFTA_Mileage_Ent
intOkToRunReportsSW = 0
Return
subFindMarkedErrors: 'Error codes between 1,2, and 11 are allowed.
Set rcst1 = db1.OpenRecordset( _
"SELECT ErrCode " _
& "FROM tbl_Haul_Data_Mileage " _
& "WHERE (((tbl_Haul_Data_Mileage.E
& "AND " & frm2.Filter & ");")
If rcst1.EOF Then
MsgBox "No Show Stopping Errors"
Else
rcst1.MoveLast
If MsgBox(rcst1.RecordCount & "Critical Errors Found." & vbCrLf _
& "Continue with Processing?", vbYesNo, "Errors Found") = vbNo Then
intOkToRunReportsSW = 1
Else
intOkToRunReportsSW = 0
'Create a note to place on report when this option is run, or error summary
End If
End If
Return
subOkToRunReports:
If intOkToRunReportsSW = 0 Then
Call subFillReportTables
Call SubStateMileageReportPivot
Call SubStateMileageReportPivot
Call SubStateMileageReportPivot
End If
Return
subCloseItUp:
rcst1.Close
db1.Close
Set rcst1 = Nothing
Set db1 = Nothing
Return
End Sub
Public Sub subFillReportTables()
GoSub subSetUp
GoSub subClearTempTables
GoSub subInsertStateTotals
GoSub subInsertTruckDetail
GoSub subCloseItUp
subSetUp:
Set db1 = CurrentDb
Return
subClearTempTables:
db1.Execute ("DELETE * FROM tbl_Haul_MilesByState;")
db1.Execute ("DELETE * FROM tbl_Haul_MilesByState2;")
db1.Execute ("DELETE * FROM tbl_Haul_TruckDetail;")
Return
subInsertStateTotals:
db1.Execute ("INSERT INTO tbl_Haul_MilesByState2 ( TruckID, State, MilesByState, GallonsByState ) " _
& "SELECT tbl_Haul_Data_Mileage.Truc
& "tbl_Haul_Data_Mileage.Hom
& "Sum(tbl_Haul_Data_Mileage
& "Sum(tbl_Haul_Data_Mileage
& "FROM tbl_Haul_Data_Mileage " _
& strWhereClause _
& "GROUP BY tbl_Haul_Data_Mileage.Truc
& " tbl_Haul_Data_Mileage.Home
db1.Execute ("INSERT INTO tbl_Haul_MilesByState2 ( TruckID, State, MilesByState, GallonsByState ) " _
& "SELECT tbl_Haul_Data_Mileage.Truc
& " tbl_Haul_Data_Mileage.OutS
& "Sum(tbl_Haul_Data_Mileage
& "Sum(tbl_Haul_Data_Mileage
& "FROM tbl_Haul_Data_Mileage " _
& strWhereClause _
& "GROUP BY tbl_Haul_Data_Mileage.Truc
& "tbl_Haul_Data_Mileage.Out
& "HAVING (((tbl_Haul_Data_Mileage.O
db1.Execute ("INSERT INTO tbl_Haul_MilesByState ( State, TruckID, MilesByState, GallonsByState ) " _
& "SELECT tbl_Haul_MilesByState2.Sta
& " tbl_Haul_MilesByState2.Tru
& "Sum(tbl_Haul_MilesByState
& "Sum(tbl_Haul_MilesByState
& "FROM tbl_Haul_MilesByState2 " _
& "GROUP BY tbl_Haul_MilesByState2.Sta
& " tbl_Haul_MilesByState2.Tru
'_________________________
'_________________________
Return
subInsertTruckDetail:
db1.Execute ("INSERT INTO tbl_Haul_TruckDetail " _
& "( HaulingDate, TruckId, BeginningMiles, EndingMiles, DriverID, LastName, FirstName, " _
& "MilesDriven, TruckFuelGallons, ShopMilesSW, MPG, ErrCode, Description, OutOfStateFuel ) " _
& "SELECT tbl_Haul_Data_Mileage.Haul
& "tbl_Haul_Data_Mileage.Tru
& "tbl_Haul_Data_Mileage.End
& "tblDriver.LastName, tblDriver.FirstName, tbl_Haul_Data_Mileage.Mile
& "tbl_Haul_Data_Mileage.Tru
& "tbl_Haul_Data_Mileage.MPG
& "tbl_Ref_ErrCodes.Descript
& "FROM (tbl_Haul_Data_Mileage " _
& "LEFT JOIN tblDriver " _
& "ON tbl_Haul_Data_Mileage.Driv
& "LEFT JOIN tbl_Ref_ErrCodes " _
& "ON tbl_Haul_Data_Mileage.ErrC
& strWhereClause _
& "ORDER BY tbl_Haul_Data_Mileage.Haul
& "tbl_Haul_Data_Mileage.Beg
& "tbl_Haul_Data_Mileage.Dri
Return
subCloseItUp:
db1.Close
Set db1 = Nothing
Exit Sub
Return
End Sub
Public Sub SubStateMileageReportPivot
Dim dbs As dao.Database
Dim rst As dao.Recordset
Dim qry As dao.QueryDef
Dim mRpt As Report
Dim ctr As Container
Dim doc As Document
Dim intDataX As Integer
Dim intDataY As Integer
Dim intLabelX As Integer
Dim intLabelY As Integer
Dim ctlText As Control
Dim ctlLabel As Control
Dim strPivot As String
Dim strName1 As String
Dim strName2 As String
Dim strName3 As String
Dim strRptName As Variant
Dim sngDiv As Single
Dim intCycle1 As Integer
Dim intCycle2 As Integer
GoSub subSetUpParameters
GoSub subsetUpStatements
GoSub subSetUpPivotTable
GoSub subSetupReportDimentions
GoSub subDeleteOldReport
GoSub subCreateReport
GoSub subFillControls
GoSub subCloseItUp
Exit Sub
subSetUpParameters:
strRptName = "rpt_Haul_Totals_State_Mil
strName3 = Format(DMin("[HaulingDate]
strName2 = Format(DMax("[HaulingDate]
strName1 = "TOTAL MILES PER STATE FOR PERIOD: " & vbCrLf & strName3 & vbCrLf & " -TO- " & vbCrLf & strName2
Return
subsetUpStatements:
strPivot = _
"TRANSFORM Sum(MilesByState) AS SumOfMilesByState " _
& "SELECT TruckID AS [Truck #], " _
& "Sum(MilesByState) AS [Total Miles] " _
& "FROM tbl_Haul_MilesByState " _
& "GROUP BY TruckID " _
& "PIVOT State;"
Return
subSetUpPivotTable:
Set dbs = CurrentDb 'Set DB
For Each qry In dbs.QueryDefs
If qry.Name = "qryStatePivot" Then 'Find and delete qry if exists
dbs.QueryDefs.Delete qry.Name
End If
Next
Set qry = dbs.CreateQueryDef("qrySta
Set rst = qry.OpenRecordset(dbOpenSn
Return
subSetupReportDimentions:
Set ctr = dbs.Containers!Reports 'Set container Object
sngDiv = (1440 * 7.5) / (rst.Fields.Count) 'Find Increments from the rst fields count
If sngDiv <= (1440 * 0.56) Then
sngDiv = (1440 * 0.56)
End If
Return
subDeleteOldReport:
For Each doc In ctr.Documents 'Find and delete existing report
If doc.Name = strRptName Then
DoCmd.SetWarnings False
DoCmd.DeleteObject acReport, doc.Name
DoCmd.SetWarnings True
End If
Next doc
Return
subCreateReport:
Set mRpt = CreateReport(, "Rpt_VarTemplate") 'Use template and recordset to create report
Set ctlLabel = CreateReportControl(mRpt.N
Set ctlLabel = CreateReportControl(mRpt.N
ctlLabel.Width = (1440 * 7.5)
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
Set ctlLabel = CreateReportControl(mRpt.N
ctlLabel.Width = (1440 * 7.5)
ctlLabel.TextAlign = 2 'Center
Return
subFillControls:
'Header
intDataX = 0
For intCycle1 = 0 To rst.Fields.Count - 1
If intCycle1 <> 1 Then
Set ctlLabel = CreateReportControl(mRpt.N
GoSub subAdjustBox
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
End If
Next
Set ctlLabel = CreateReportControl(mRpt.N
GoSub subAdjustBox
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
'detail
intDataX = 0
rst.MoveFirst
intCycle2 = intCycle2 + 1
Do Until rst.EOF
For intCycle1 = 0 To rst.Fields.Count - 1
If intCycle1 <> 1 Then
Set ctlLabel = CreateReportControl(mRpt.N
If IsNull(rst.Fields(intCycle
ctlLabel.Caption = ""
Else
ctlLabel.Caption = rst.Fields(intCycle1).Valu
End If
GoSub subAdjustBox
End If
Next
Set ctlLabel = CreateReportControl(mRpt.N
If IsNull(rst.Fields(1).Value
ctlLabel.Caption = ""
Else
ctlLabel.Caption = rst.Fields(1).Value
End If
GoSub subAdjustBox
rst.MoveNext
intCycle2 = intCycle2 + 1
intDataX = 0
Loop
'totals, still in detail
intDataX = 0
For intCycle1 = 0 To rst.Fields.Count - 1
If intCycle1 > 1 Then
Set ctlLabel = CreateReportControl(mRpt.N
GoSub subAdjustBox
ElseIf intCycle1 = 0 Then
Set ctlLabel = CreateReportControl(mRpt.N
intDataX = 0
GoSub subAdjustBox
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
End If
Next
Set ctlLabel = CreateReportControl(mRpt.N
GoSub subAdjustBox
Return
subAdjustBox:
ctlLabel.BorderStyle = 1
ctlLabel.TextAlign = 3 'Center
ctlLabel.Width = sngDiv
intDataX = intDataX + sngDiv
Return
subCloseItUp:
'MsgBox "Done"
DoCmd.Restore
DoCmd.Save acReport, mRpt.Name
DoCmd.Close acReport, mRpt.Name
DoCmd.SetWarnings False
DoCmd.Rename strRptName, acReport, "Report1"
DoCmd.SetWarnings True
DoCmd.Maximize
rst.Close
dbs.QueryDefs.Delete qry.Name
dbs.Close
Return
End Sub
Public Sub SubStateMileageReportPivot
Dim dbs As dao.Database
Dim rst As dao.Recordset
Dim qry As dao.QueryDef
Dim mRpt As Report
Dim ctr As Container
Dim doc As Document
Dim intDataX As Integer
Dim intDataY As Integer
Dim intLabelX As Integer
Dim intLabelY As Integer
Dim ctlText As Control
Dim ctlLabel As Control
Dim strPivot As String
Dim strName1 As String
Dim strName2 As String
Dim strName3 As String
Dim strRptName As Variant
Dim sngDiv As Single
Dim intCycle1 As Integer
Dim intCycle2 As Integer
GoSub subSetUpParameters
GoSub subsetUpStatements
GoSub subSetUpPivotTable
GoSub subSetupReportDimentions
GoSub subDeleteOldReport
GoSub subCreateReport
GoSub subFillControls
GoSub subCloseItUp
Exit Sub
subSetUpParameters:
strRptName = "rpt_Haul_Totals_State_Mil
strName3 = Format(DMin("[HaulingDate]
strName2 = Format(DMax("[HaulingDate]
strName1 = "TOTAL MPG PER STATE FOR PERIOD: " & vbCrLf & strName3 & vbCrLf & " -TO- " & vbCrLf & strName2
Return
subsetUpStatements:
strPivot = _
"TRANSFORM Sum([milesDriven])/(IIF(is
& "+ IIF(isnull(Sum([OutOfState
& "SELECT tbl_Haul_TruckDetail.Truck
& "Sum([milesDriven])/(Sum([
& "FROM tbl_Haul_MilesByState " _
& "LEFT JOIN tbl_Haul_TruckDetail " _
& "ON tbl_Haul_MilesByState.Truc
& "GROUP BY tbl_Haul_TruckDetail.Truck
& "PIVOT tbl_Haul_MilesByState.Stat
Return
subSetUpPivotTable:
Set dbs = CurrentDb 'Set DB
For Each qry In dbs.QueryDefs
If qry.Name = "qryStateMPGPivot" Then 'Find and delete qry if exists
dbs.QueryDefs.Delete qry.Name
End If
Next
Set qry = dbs.CreateQueryDef("qrySta
Set rst = qry.OpenRecordset(dbOpenSn
Return
subSetupReportDimentions:
Set ctr = dbs.Containers!Reports 'Set container Object
sngDiv = (1440 * 7.5) / (rst.Fields.Count) 'Find Increments from the rst fields count
If sngDiv <= (1440 * 0.56) Then
sngDiv = (1440 * 0.56)
End If
Return
subDeleteOldReport:
For Each doc In ctr.Documents 'Find and delete existing report
If doc.Name = strRptName Then
DoCmd.SetWarnings False
DoCmd.DeleteObject acReport, doc.Name
DoCmd.SetWarnings True
End If
Next doc
Return
subCreateReport:
Set mRpt = CreateReport(, "Rpt_VarTemplate") 'Use template and recordset to create report
Set ctlLabel = CreateReportControl(mRpt.N
Set ctlLabel = CreateReportControl(mRpt.N
ctlLabel.Width = (1440 * 7.5)
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
Set ctlLabel = CreateReportControl(mRpt.N
ctlLabel.Width = (1440 * 7.5)
ctlLabel.TextAlign = 2 'Center
Return
subFillControls:
'Header
intDataX = 0
For intCycle1 = 0 To rst.Fields.Count - 1
If intCycle1 <> 1 Then
Set ctlLabel = CreateReportControl(mRpt.N
GoSub subAdjustBox
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
End If
Next
Set ctlLabel = CreateReportControl(mRpt.N
GoSub subAdjustBox
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
'detail
intDataX = 0
rst.MoveFirst
intCycle2 = intCycle2 + 1
Do Until rst.EOF
For intCycle1 = 0 To rst.Fields.Count - 1
If intCycle1 <> 1 Then
Set ctlLabel = CreateReportControl(mRpt.N
If IsNull(rst.Fields(intCycle
ctlLabel.Caption = ""
Else
If intCycle1 <> 0 Then
ctlLabel.Caption = Format(rst.Fields(intCycle
Else
ctlLabel.Caption = rst.Fields(intCycle1).Valu
End If
End If
GoSub subAdjustBox
End If
Next
Set ctlLabel = CreateReportControl(mRpt.N
If IsNull(rst.Fields(1).Value
ctlLabel.Caption = ""
Else
ctlLabel.Caption = Format(rst.Fields(1).Value
End If
GoSub subAdjustBox
rst.MoveNext
intCycle2 = intCycle2 + 1
intDataX = 0
Loop
'totals, still in detail
intDataX = 0
For intCycle1 = 0 To rst.Fields.Count - 1
If intCycle1 > 1 Then
Set ctlLabel = CreateReportControl(mRpt.N
GoSub subAdjustBox
ElseIf intCycle1 = 0 Then
Set ctlLabel = CreateReportControl(mRpt.N
intDataX = 0
GoSub subAdjustBox
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
End If
Next
Set ctlLabel = CreateReportControl(mRpt.N
GoSub subAdjustBox
Return
subAdjustBox:
ctlLabel.BorderStyle = 1
ctlLabel.TextAlign = 3 'Center
ctlLabel.Width = sngDiv
intDataX = intDataX + sngDiv
Return
subCloseItUp:
'MsgBox "Done"
DoCmd.Restore
DoCmd.Save acReport, mRpt.Name
DoCmd.Close acReport, mRpt.Name
DoCmd.SetWarnings False
DoCmd.Rename strRptName, acReport, "Report1"
DoCmd.SetWarnings True
DoCmd.Maximize
rst.Close
dbs.QueryDefs.Delete qry.Name
dbs.Close
Return
End Sub
Public Sub SubStateMileageReportPivot
Dim dbs As dao.Database
Dim rst As dao.Recordset
Dim qry As dao.QueryDef
Dim mRpt As Report
Dim ctr As Container
Dim doc As Document
Dim intDataX As Integer
Dim intDataY As Integer
Dim intLabelX As Integer
Dim intLabelY As Integer
Dim ctlText As Control
Dim ctlLabel As Control
Dim strPivot As String
Dim strName1 As String
Dim strName2 As String
Dim strName3 As String
Dim strRptName As Variant
Dim sngDiv As Single
Dim intCycle1 As Integer
Dim intCycle2 As Integer
GoSub subSetUpParameters
GoSub subsetUpStatements
GoSub subSetUpPivotTable
GoSub subSetupReportDimentions
GoSub subDeleteOldReport
GoSub subCreateReport
GoSub subFillControls
GoSub subCloseItUp
Exit Sub
subSetUpParameters:
strRptName = "rpt_Haul_Totals_State_Mil
strName3 = Format(DMin("[HaulingDate]
strName2 = Format(DMax("[HaulingDate]
strName1 = "TOTAL GALLONS PER STATE FOR PERIOD: " & vbCrLf & strName3 & vbCrLf & " -TO- " & vbCrLf & strName2
Return
subsetUpStatements:
strPivot = _
"TRANSFORM Sum(GallonsByState) AS SumOfGallonsByState " _
& "SELECT TruckID AS [Truck #], " _
& "Sum(GallonsByState) AS [Total Gallons] " _
& "FROM tbl_Haul_MilesByState " _
& "GROUP BY TruckID " _
& "PIVOT State;"
Return
subSetUpPivotTable:
Set dbs = CurrentDb 'Set DB
For Each qry In dbs.QueryDefs
If qry.Name = "qryStateGallonPivot" Then 'Find and delete qry if exists
dbs.QueryDefs.Delete qry.Name
End If
Next
Set qry = dbs.CreateQueryDef("qrySta
Set rst = qry.OpenRecordset(dbOpenSn
Return
subSetupReportDimentions:
Set ctr = dbs.Containers!Reports 'Set container Object
sngDiv = (1440 * 7.5) / (rst.Fields.Count) 'Find Increments from the rst fields count
If sngDiv <= (1440 * 0.56) Then
sngDiv = (1440 * 0.56)
End If
Return
subDeleteOldReport:
For Each doc In ctr.Documents 'Find and delete existing report
If doc.Name = strRptName Then
DoCmd.SetWarnings False
DoCmd.DeleteObject acReport, doc.Name
DoCmd.SetWarnings True
End If
Next doc
Return
subCreateReport:
Set mRpt = CreateReport(, "Rpt_VarTemplate") 'Use template and recordset to create report
Set ctlLabel = CreateReportControl(mRpt.N
Set ctlLabel = CreateReportControl(mRpt.N
ctlLabel.Width = (1440 * 7.5)
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
Set ctlLabel = CreateReportControl(mRpt.N
ctlLabel.Width = (1440 * 7.5)
ctlLabel.TextAlign = 2 'Center
Return
subFillControls:
'Header
intDataX = 0
For intCycle1 = 0 To rst.Fields.Count - 1
If intCycle1 <> 1 Then
Set ctlLabel = CreateReportControl(mRpt.N
GoSub subAdjustBox
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
End If
Next
Set ctlLabel = CreateReportControl(mRpt.N
GoSub subAdjustBox
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
'detail
intDataX = 0
rst.MoveFirst
intCycle2 = intCycle2 + 1
Do Until rst.EOF
For intCycle1 = 0 To rst.Fields.Count - 1
If intCycle1 <> 1 Then
Set ctlLabel = CreateReportControl(mRpt.N
If IsNull(rst.Fields(intCycle
ctlLabel.Caption = ""
Else
ctlLabel.Caption = rst.Fields(intCycle1).Valu
End If
GoSub subAdjustBox
End If
Next
Set ctlLabel = CreateReportControl(mRpt.N
If IsNull(rst.Fields(1).Value
ctlLabel.Caption = ""
Else
ctlLabel.Caption = rst.Fields(1).Value
End If
GoSub subAdjustBox
rst.MoveNext
intCycle2 = intCycle2 + 1
intDataX = 0
Loop
'totals, still in detail
intDataX = 0
For intCycle1 = 0 To rst.Fields.Count - 1
If intCycle1 > 1 Then
Set ctlLabel = CreateReportControl(mRpt.N
GoSub subAdjustBox
ElseIf intCycle1 = 0 Then
Set ctlLabel = CreateReportControl(mRpt.N
intDataX = 0
GoSub subAdjustBox
ctlLabel.TextAlign = 2 'Center
ctlLabel.FontWeight = 700 'bold
End If
Next
Set ctlLabel = CreateReportControl(mRpt.N
GoSub subAdjustBox
Return
subAdjustBox:
ctlLabel.BorderStyle = 1
ctlLabel.TextAlign = 3 'Center
ctlLabel.Width = sngDiv
intDataX = intDataX + sngDiv
Return
subCloseItUp:
'MsgBox "Done"
DoCmd.Restore
DoCmd.Save acReport, mRpt.Name
DoCmd.Close acReport, mRpt.Name
DoCmd.SetWarnings False
DoCmd.Rename strRptName, acReport, "Report1"
DoCmd.SetWarnings True
DoCmd.Maximize
rst.Close
dbs.QueryDefs.Delete qry.Name
dbs.Close
Return
End Sub
Public Sub subPrintMileageReports()
DoCmd.OpenReport "rpt_Haul_Detail_Truck_Mil
DoCmd.OpenReport "rpt_Haul_Totals_State_Mil
DoCmd.OpenReport "rpt_Haul_Totals_State_Mil
DoCmd.OpenReport "rpt_Haul_Totals_State_Mil
End Sub
Public Sub subErrorList()
GoSub subSetUp
GoSub subProcess
GoSub subDisplay
GoSub subCloseItUp
Exit Sub
subSetUp:
strMessage = ""
Set db1 = CurrentDb
Set rcst1 = db1.OpenRecordset("SELECT Errcode, Description FROM tbl_Ref_ErrCodes;")
Return
subProcess:
With rcst1
rcst1.MoveFirst
Do Until .EOF
strMessage = strMessage & Space(2 - Len(rcst1!ErrCode)) & rcst1!ErrCode _
& " - " & rcst1!Description & vbCrLf
rcst1.MoveNext
Loop
End With
Return
subDisplay:
MsgBox strMessage
Return
subCloseItUp:
rcst1.Close
db1.Close
Set rcst1 = Nothing
Set db1 = Nothing
Return
End Sub
'
' InStateCode cannot equal OutStateCode 'Done
' If there is no InStateCode there can be no InStateMiles 'Done
' If there is no OutStateCode there can be no OutStateMiles 'Done
' If there is an InStateCode there must be InStateMiles 'Done
' If there is an OutStateCode there must be OutStateMiles 'Done
' Must be at least one State code 'Done
' Is InStateCode a state 'done
' Is OutStateCode a state 'done
'If multiple errors are on the record, only the last error found will show
'Set rcst1 = db1.OpenRecordset( _
' "SELECT HomeStateCode, OutStateCode, " _
' & "Sum(tbl_Haul_Data_Mileage
' & "Sum(tbl_Haul_Data_Mileage
' & "Sum(tbl_Haul_Data_Mileage
' & "FROM tbl_Haul_Data_Mileage " _
' & "WHERE (((tbl_Haul_Data_Mileage.H
' & "And (tbl_Haul_Data_Mileage.Hau
' & "GROUP BY tbl_Haul_Data_Mileage.Home
'db1.Execute ("INSERT INTO tbl_Haul_MilesByState ( State, MilesByState ) " _
' & "SELECT tbl_Haul_Data_Mileage.Home
' & "Sum(tbl_Haul_Data_Mileage
' & "FROM tbl_Haul_Data_Mileage " _
' & "WHERE (((tbl_Haul_Data_Mileage.H
' & "And (tbl_Haul_Data_Mileage.Hau
' & "GROUP BY tbl_Haul_Data_Mileage.Home
'
'db1.Execute ("INSERT INTO tbl_Haul_MilesByState ( State, MilesByState ) " _
' & "SELECT tbl_Haul_Data_Mileage.OutS
' & "Sum(tbl_Haul_Data_Mileage
' & "FROM tbl_Haul_Data_Mileage " _
' & "WHERE (((tbl_Haul_Data_Mileage.H
' & "And (tbl_Haul_Data_Mileage.Hau
' & "GROUP BY tbl_Haul_Data_Mileage.OutS
' & "HAVING (((tbl_Haul_Data_Mileage.O
'Last months begin and end dates
' frm1.TxtBegin.Value = Format((DateAdd("m", -1, Date) - _
' Day(DateAdd("m", -1, Date))) + 1, "mm/dd/yy")
' frm1.TxtEnd.Value = Format(Date - Day(Date), "Short Date")
'Don't toss out just yet. This sub found in procedure subErrorCheckUpdate
'subRunFilters:
' If strBadGuyClause = "" Then
' 'frm2.Filter = strDateRangeClause
' Else
' On Error GoTo ErrorThingy
'
' frm2.Filter = strDateRangeClause & " AND " & strBadGuyClause
' End If
' strBadGuyClause = ""
' Call subStowMileageFilter
'db1.Execute ("INSERT INTO tbl_Haul_MilesByState2 ( TruckID, State, MilesByState ) " _
' & "SELECT tbl_Haul_Data_Mileage.Truc
' & "tbl_Haul_Data_Mileage.Hom
' & "Sum(tbl_Haul_Data_Mileage
' & "FROM tbl_Haul_Data_Mileage " _
' & strWhereClause _
' & "GROUP BY tbl_Haul_Data_Mileage.Truc
' & "tbl_Haul_Data_Mileage.Hom
'
'db1.Execute ("INSERT INTO tbl_Haul_MilesByState2 ( TruckID, State, GallonsByState ) " _
' & "SELECT tbl_Haul_Data_Mileage.Truc
' & "tbl_Haul_Data_Mileage.Hom
' & "Sum(tbl_Haul_Data_Mileage
' & "FROM tbl_Haul_Data_Mileage " _
' & strWhereClause _
' & "GROUP BY tbl_Haul_Data_Mileage.Truc
' & "tbl_Haul_Data_Mileage.Hom
' & "tbl_Haul_Data_Mileage.Out
' & "HAVING (((tbl_Haul_Data_Mileage.O
'
'db1.Execute ("INSERT INTO tbl_Haul_MilesByState2 ( TruckID, MilesByState, State ) " _
' & "SELECT tbl_Haul_Data_Mileage.Truc
' & "Sum(tbl_Haul_Data_Mileage
' & "tbl_Haul_Data_Mileage.Out
' & "FROM tbl_Haul_Data_Mileage " _
' & strWhereClause _
' & "GROUP BY tbl_Haul_Data_Mileage.Truc
' & "tbl_Haul_Data_Mileage.Out
' & "HAVING (((tbl_Haul_Data_Mileage.O
'
'db1.Execute ("INSERT INTO tbl_Haul_MilesByState2 ( TruckID, GallonsByState, State ) " _
' & "SELECT tbl_Haul_Data_Mileage.Truc
' & "Sum(tbl_Haul_Data_Mileage
' & "tbl_Haul_Data_Mileage.Out
' & "FROM tbl_Haul_Data_Mileage " _
' & strWhereClause _
' & "GROUP BY tbl_Haul_Data_Mileage.Truc
' & "tbl_Haul_Data_Mileage.Out
' & "HAVING (((tbl_Haul_Data_Mileage.O
'
'db1.Execute ("INSERT INTO tbl_Haul_MilesByState ( TruckID, State, MilesByState, GallonsByState ) " _
' & "SELECT tbl_Haul_MilesByState2.Tru
' & "tbl_Haul_MilesByState2.St
' & "Sum(tbl_Haul_MilesByState
' & "Sum(tbl_Haul_MilesByState
' & "FROM tbl_Haul_MilesByState2 " _
' & "GROUP BY tbl_Haul_MilesByState2.Tru
' & "tbl_Haul_MilesByState2.St
' & "ORDER BY tbl_Haul_MilesByState2.Tru
' & "tbl_Haul_MilesByState2.St
'
'
' '_________________________
'
'
'
'' db1.Execute ("INSERT INTO tbl_Haul_MilesByState ( State, TruckId, MilesByState, MPGByState, GallonsByState ) " _
'' & "SELECT HomeStateCode, TruckId, " _
'' & "Sum(tbl_Haul_Data_Mileage
'' & "SumOfInStateMiles / SumOfTruckFuelGallons AS AvgOfMPG, " _
'' & "Sum(tbl_Haul_Data_Mileage
'' & "FROM tbl_Haul_Data_Mileage " _
'' & strWhereClause _
'' & "GROUP BY tbl_Haul_Data_Mileage.Home
'' & "tbl_Haul_Data_Mileage.Tru
'' & "tbl_Haul_Data_Mileage.Out
'' & "HAVING (((tbl_Haul_Data_Mileage.O
''
'' db1.Execute ("INSERT INTO tbl_Haul_MilesByState ( State, TruckId, MilesByState, MPGByState, GallonsByState ) " _
'' & "SELECT OutStateCode, TruckId," _
'' & "Sum(OutStateMiles) AS SumOfOutStateMiles, " _
'' & "SumOfOutStateMiles / SumOfTruckGallons AS AvgOfMPG, " _
'' & "Sum(TruckFuelGallons) AS SumOfTruckGallons " _
'' & "FROM tbl_Haul_Data_Mileage " _
'' & strWhereClause _
'' & "GROUP BY OutStateCode, TruckId " _
'' & "HAVING (((OutStateCode) Is Not Null));")
can you show the complete SQL for the WHERE clause
btw .... there is no need to Close the recordset clone object ... just Set it to Nothing.
mx
btw .... there is no need to Close the recordset clone object ... just Set it to Nothing.
mx
ASKER
DatabaseMX, how do I show you the complete SQL for the WHERE clause? I am no ACCESS guru, I work with VB a lot.
Sorry ... I meant can you show there strWhereClause is defined. My screen has now just exploded with all the code you posted, lol .... so, as soon as I replace my display ... I'll Be Back :-)
mx
mx
ASKER
lol data,
I have no idea unless you mean in the code, is there a table I need to look in?
I have no idea unless you mean in the code, is there a table I need to look in?
db1.Execute ("UPDATE tbl_Haul_Data_Mileage SET ErrCode = " & intErrCode & " " & strWhereClause & ";")
Is ErrCode a numeric value ?
What is the intent of the concatenation ?
mx
ASKER
mx maybe I should not have even asked this question. I didn't design it so I have not a clue. Seems to be a database table error and not in the code itself. So that is where we are at this point.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
It now seems there was a reference to the state of FL in there somewhere, we took that out of the table and it worked. Hmmm, still not sure. Any ideas?
I would have to 'be there' :-)
sorry ...
mx
sorry ...
mx