Thanks to everyone who has replied!!!!
I am working from the original adp file as i always make backups and when things have no effect, i would rather note that and work again with the original file (esp. with something like VB that i know little about).
1. Everything is in its original state, the import that i did was done in a different version of the file for testing.
2. No code was sacrificed for the purposes of producing this file.
3. This I"m not sure about yet. It connects to a single SQL database, and the odbc info is intact. I will have to go line by line to see if the references are different. I also have a 2007 version of the file that is working perfectly so i can compare them as well to see what could possibly be different opening it with 2010.
All of the original modules are in it, and here is the class module for TaggedValues is below:
Option Compare Database
Public defASEffectiveDate As Date, defASRunNbr As Integer
Public defDSMEffectiveDate As Date, defDSMRunNbr As Integer
Public defDSMAssignmentTypeId As Integer, defDSMServiceType As Integer
Public Function SetDefaults()
defASEffectiveDate = #1/1/1900#
defASRunNbr = Empty
defDSMEffectiveDate = #1/1/1900#
defDSMRunNbr = Empty
defDSMAssignmentTypeId = Empty
defDSMServiceType = Empty
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
With rst
Set .ActiveConnection = CurrentProject.Connection
.Source = "SELECT effective_date, " & _
"min(run_nbr) as run_nbr FROM actual_service " & _
"WHERE effective_date = " & _
"(Select Min(effective_date) from actual_service) " & _
"GROUP BY effective_date "
.CursorLocation = adUseClient
.LockType = adLockReadOnly
.CursorType = adOpenStatic
.Open
If .RecordCount > 0 Then
defASEffectiveDate = .Fields("Effective_date")
defASRunNbr = .Fields("run_nbr")
End If
.Close
.Source = "SELECT effective_date, " & _
"min(run_nbr) as run_nbr, " & _
"min(AssignmentTypeId) as AssignmentTypeId, " & _
"min(Service_Type) as Service_Type " & _
"FROM sched_proposed " & _
"WHERE effective_date = " & _
"(Select Min(effective_date) from sched_proposed) " & _
"GROUP BY effective_date "
.CursorLocation = adUseClient
.LockType = adLockReadOnly
.CursorType = adOpenStatic
.Open
If .RecordCount > 0 Then
defDSMEffectiveDate = .Fields("Effective_Date")
defDSMRunNbr = .Fields("run_nbr")
defDSMAssignmentTypeId = .Fields("AssignmentTypeId")
defDSMServiceType = .Fields("Service_Type")
End If
.Close
End With
End Function
Function SetStartupProperties()
Const DB_Text As Long = 10
Const DB_Boolean As Long = 1
'ChangeProperty "StartupForm", DB_Text, "Customers"
ChangeProperty "StartupShowDBWindow", DB_Boolean, False
ChangeProperty "StartupShowStatusBar", DB_Boolean, False
ChangeProperty "AllowBuiltinToolbars", DB_Boolean, False
ChangeProperty "AllowFullMenus", DB_Boolean, False
ChangeProperty "AllowBreakIntoCode", DB_Boolean, False
ChangeProperty "AllowSpecialKeys", DB_Boolean, True
ChangeProperty "AllowBypassKey", DB_Boolean, True
End Function
Function SetLorrieStartup()
Const DB_Text As Long = 10
Const DB_Boolean As Long = 1
'ChangeProperty "StartupForm", DB_Text, "Customers"
ChangeProperty "StartupShowDBWindow", DB_Boolean, False
ChangeProperty "StartupShowStatusBar", DB_Boolean, False
ChangeProperty "AllowBuiltinToolbars", DB_Boolean, True
ChangeProperty "AllowFullMenus", DB_Boolean, True
ChangeProperty "AllowBreakIntoCode", DB_Boolean, True
ChangeProperty "AllowSpecialKeys", DB_Boolean, True
ChangeProperty "AllowBypassKey", DB_Boolean, True
End Function
'
'Public Function SetStartupProperties()
'CurrentProject.Properties.Add "AppTitle", "Mileage Manager"
'CurrentProject.Properties.Add "StartupShowDBWindow", False
'CurrentProject.Properties.Add "StartupMenuBar", "Mileage Manager"
'CurrentProject.Properties.Add "AllowFullMenus", True
'Application.RefreshTitleBar
'End Function
Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
Dim dbs As Object, prp As Variant
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo Change_Err
dbs.Properties(strPropName) = varPropValue
ChangeProperty = True
Change_Bye:
Exit Function
Change_Err:
If Err = conPropNotFoundError Then ' Property not found.
Set prp = dbs.CreateProperty(strPropName, _
varPropType, varPropValue)
dbs.Properties.Append prp
Resume Next
Else
' Unknown error.
ChangeProperty = False
Resume Change_Bye
End If
End Function
Public Function AssignmentName(iAssignmentTypeId As Integer) As String
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
AssignmentName = ""
With rst
Set .ActiveConnection = CurrentProject.Connection
.Source = "SELECT AssignmentType from Assignments " & _
"WHERE AssignmentTypeId=" & Trim(Str(iAssignmentTypeId))
.CursorLocation = adUseClient
.LockType = adLockReadOnly
.CursorType = adOpenStatic
.Open
AssignmentName = .Fields("AssignmentType")
End With
End Function
Public Function ServiceName(iServiceTypeId As Integer) As String
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
ServiceName = ""
With rst
Set .ActiveConnection = CurrentProject.Connection
.Source = "SELECT ServiceType from Service_Types " & _
"WHERE ServiceTypeId=" & Trim(Str(iServiceTypeId))
.CursorLocation = adUseClient
.LockType = adLockReadOnly
.CursorType = adOpenStatic
.Open
ServiceName = .Fields("ServiceType")
End With
End Function
Public Function UpdateDASMSubtotals()
Dim mDate As Date, mRoute As Integer, mRun As Integer, mAssignment As Integer
Dim mService As Integer, mVehicle As Integer
Dim sDate As String, sRoute As String, sRun As String, sAssignment As String
Dim sService As String
mDate = [Forms]![Daily Actual Service Miles]![ActualServiceSubForm]![Date]
mRoute = [Forms]![Daily Actual Service Miles]![ActualServiceSubForm]![Route]
mRun = [Forms]![Daily Actual Service Miles]![ActualServiceSubForm]![Run]
mAssignment = [Forms]![Daily Actual Service Miles]![ActualServiceSubForm]![Assignment]
mService = [Forms]![Daily Actual Service Miles]![ActualServiceSubForm]![Service]
mVehicle = [Forms]![Daily Actual Service Miles]![ActualServiceSubForm]![Veh]
Dim strWhere As String, rst As ADODB.Recordset
sDate = Format(mDate, "yyyy-m-d")
sRoute = Trim(Str(mRoute))
sRun = Trim(Str(mRun))
sAssignment = Trim(Str(mAssignment))
sService = Trim(Str(mService))
sVehicle = Trim(Str(mVehicle))
Set rst = New ADODB.Recordset
With rst
Set .ActiveConnection = CurrentProject.Connection
.Source = "SELECT sum(act_revenue_miles) as SumActRevMiles, " & _
"sum(act_deadhead_miles) as SumActDHMiles, " & _
"sum(act_revenue_minutes) as SumActRevMin, " & _
"sum(act_deadhead_minutes) as SumActDHMin " & _
"from actual_service " & _
"WHERE effective_date='" & sDate & _
"' AND route_id =" & sRoute & " AND run_nbr = " & sRun & _
" AND assigned_vehicle=" & sVehicle & _
" AND service_type = " & sService & _
" AND AssignmentTypeId = " & sAssignment
.CursorLocation = adUseClient
.LockType = adLockReadOnly
.CursorType = adOpenStatic
.Open
[Forms]![Daily Actual Service Miles]![txtDASMSubActRevMiles] = .Fields("SumActRevMiles")
[Forms]![Daily Actual Service Miles]![txtDASMSubActDHMiles] = .Fields("SumActDHMiles")
[Forms]![Daily Actual Service Miles]![txtDASMSubActRevMin] = .Fields("SumActRevMin")
[Forms]![Daily Actual Service Miles]![txtDASMSubActDHMin] = .Fields("SumActDHMin")
'MsgBox Str(.RecordCount)
End With
'MsgBox "Date " & sDate & " Run " & sRun & " Tot " & Str(Me.txtDASMTotalActRevMiles)
'Me.Form.Requery
'Me.ActualServiceSubForm.Requery
[Forms]![Daily Actual Service Miles]!txtSubDate = [Forms]![Daily Actual Service Miles]![ActualServiceSubForm]![Date]
[Forms]![Daily Actual Service Miles]!txtSubRoute = [Forms]![Daily Actual Service Miles]![ActualServiceSubForm]![Route]
[Forms]![Daily Actual Service Miles]!txtSubRun = [Forms]![Daily Actual Service Miles]![ActualServiceSubForm]![Run]
[Forms]![Daily Actual Service Miles]!txtSubAssignment = [Forms]![Daily Actual Service Miles]![ActualServiceSubForm]![Assignment]
[Forms]![Daily Actual Service Miles]!txtSubVeh = [Forms]![Daily Actual Service Miles]![ActualServiceSubForm]![Veh]
[Forms]![Daily Actual Service Miles]!txtSubService = [Forms]![Daily Actual Service Miles]![ActualServiceSubForm]![Service]
[Forms]![Daily Actual Service Miles]!txtSubAssignmentName = AssignmentName([Forms]![Daily Actual Service Miles]!txtSubAssignment)
[Forms]![Daily Actual Service Miles]!txtSubServiceName = ServiceName([Forms]![Daily Actual Service Miles]!txtSubService)
End Function
Public Function UpdateDASMTotals()
Dim strWhere As String, rst As ADODB.Recordset
Dim sDate As String, sRun As String
Dim mDate As Date, mRun As Integer
If IsNull([Forms]![Daily Actual Service Miles]![cmbEffDate]) Then
mDate = #1/1/1900#
Else
mDate = [Forms]![Daily Actual Service Miles]![cmbEffDate]
End If
If IsNull([Forms]![Daily Actual Service Miles]![cmbRunNumber]) Then
mRun = 0
Else
mRun = [Forms]![Daily Actual Service Miles]![cmbRunNumber]
End If
sDate = Format(mDate, "yyyy-m-d")
sRun = Trim(Str(mRun))
'MsgBox "Date " & sDate & " Run " & sRun & " Tot " & Str(Me.txtDASMTotalActRevMiles)
strWhere = "effective_date IS NOT NULL"
Set rst = New ADODB.Recordset
If Not (mDate = #1/1/1900#) Then
strWhere = strWhere & " AND effective_date = '" & sDate & "'"
End If
If Not (mRun = 0) Then
strWhere = strWhere & " AND run_nbr = " & sRun
End If
With rst
Set .ActiveConnection = CurrentProject.Connection
.Source = "SELECT sum(act_revenue_miles) as SumActRevMiles, " & _
"sum(act_deadhead_miles) as SumActDHMiles, " & _
"sum(act_revenue_minutes) as SumActRevMin, " & _
"sum(act_deadhead_minutes) as SumActDHMin " & _
"from actual_service " & _
"WHERE " & strWhere
.CursorLocation = adUseClient
.LockType = adLockReadOnly
.CursorType = adOpenStatic
.Open
[Forms]![Daily Actual Service Miles]![txtDASMTotActRevMiles] = _
.Fields("SumActRevMiles")
[Forms]![Daily Actual Service Miles]![txtDASMTotActDHMiles] = _
.Fields("SumActDHMiles")
[Forms]![Daily Actual Service Miles]![txtDASMTotActRevMin] = _
.Fields("SumActRevMin")
[Forms]![Daily Actual Service Miles]![txtDASMTotActDHMin] = _
.Fields("SumActDHMin")
.Close
End With
End Function
Public Function UpdateMPSSubtotals()
Dim mDate As Date, mRoute As Integer, mRun As Integer, mAssignment As Integer
Dim mService As Integer, mVehicle As Integer
Dim sDate As String, sRoute As String, sRun As String, sAssignment As String
Dim sService As String
mDate = [Forms]![Maintain Proposed Schedule]![ProposedScheduleSubForm]![Date]
mRoute = [Forms]![Maintain Proposed Schedule]![ProposedScheduleSubForm]![Route]
mRun = [Forms]![Maintain Proposed Schedule]![ProposedScheduleSubForm]![Run]
mAssignment = [Forms]![Maintain Proposed Schedule]![ProposedScheduleSubForm]![Assignment]
mService = [Forms]![Maintain Proposed Schedule]![ProposedScheduleSubForm]![Service]
If IsNull([Forms]![Maintain Proposed Schedule]![ProposedScheduleSubForm]![Veh]) Then
mVehicle = 9999
Else
mVehicle = [Forms]![Maintain Proposed Schedule]![ProposedScheduleSubForm]![Veh]
End If
Dim strWhere As String, rst As ADODB.Recordset
sDate = Format(mDate, "yyyy-m-d")
sRoute = Trim(Str(mRoute))
sRun = Trim(Str(mRun))
sAssignment = Trim(Str(mAssignment))
sService = Trim(Str(mService))
sVehicle = Trim(Str(mVehicle))
Set rst = New ADODB.Recordset
With rst
Set .ActiveConnection = CurrentProject.Connection
.Source = "SELECT sum(revenue_miles) as SumRevMiles, " & _
"sum(deadhead_miles) as SumDHMiles, " & _
"sum(revenue_minutes) as SumRevMin, " & _
"sum(deadhead_minutes) as SumDHMin " & _
"from sched_proposed " & _
"WHERE effective_date='" & sDate & _
"' AND route_id =" & sRoute & " AND run_nbr = " & sRun & _
" AND assigned_vehicle=" & sVehicle & _
" AND service_type = " & sService & _
" AND AssignmentTypeId = " & sAssignment
.CursorLocation = adUseClient
.LockType = adLockReadOnly
.CursorType = adOpenStatic
.Open
[Forms]![Maintain Proposed Schedule]![txtMPSSubRevMiles] = .Fields("SumRevMiles")
[Forms]![Maintain Proposed Schedule]![txtMPSSubDHMiles] = .Fields("SumDHMiles")
[Forms]![Maintain Proposed Schedule]![txtMPSSubRevMin] = .Fields("SumRevMin")
[Forms]![Maintain Proposed Schedule]![txtMPSSubDHMin] = .Fields("SumDHMin")
'MsgBox Str(.RecordCount)
End With
'MsgBox "Date " & sDate & " Run " & sRun & " Tot " & Str(Me.txtDASMTotalActRevMiles)
'Me.Form.Requery
'Me.ActualServiceSubForm.Requery
[Forms]![Maintain Proposed Schedule]!txtSubDate = [Forms]![Maintain Proposed Schedule]![ProposedScheduleSubForm]![Date]
[Forms]![Maintain Proposed Schedule]!txtSubRoute = [Forms]![Maintain Proposed Schedule]![ProposedScheduleSubForm]![Route]
[Forms]![Maintain Proposed Schedule]!txtSubRun = [Forms]![Maintain Proposed Schedule]![ProposedScheduleSubForm]![Run]
[Forms]![Maintain Proposed Schedule]!txtSubAssignment = [Forms]![Maintain Proposed Schedule]![ProposedScheduleSubForm]![Assignment]
[Forms]![Maintain Proposed Schedule]!txtSubVeh = [Forms]![Maintain Proposed Schedule]![ProposedScheduleSubForm]![Veh]
[Forms]![Maintain Proposed Schedule]!txtSubService = [Forms]![Maintain Proposed Schedule]![ProposedScheduleSubForm]![Service]
[Forms]![Maintain Proposed Schedule]!txtSubAssignmentName = AssignmentName([Forms]![Maintain Proposed Schedule]!txtSubAssignment)
[Forms]![Maintain Proposed Schedule]!txtSubServiceName = ServiceName([Forms]![Maintain Proposed Schedule]!txtSubService)
End Function
Public Function UpdateMPSTotals()
Dim strWhere As String, rst As ADODB.Recordset
Dim sDate As String, sRun As String
Dim sAssignment As String, sService As String
Dim mDate As Date, mRun As Integer, mAssignment As Integer, mService As Integer
If IsNull([Forms]![Maintain Proposed Schedule]![cmbEffDate]) Then
mDate = #1/1/1900#
Else
mDate = [Forms]![Maintain Proposed Schedule]![cmbEffDate]
End If
If IsNull([Forms]![Maintain Proposed Schedule]![cmbRunNumber]) Then
mRun = 0
Else
mRun = [Forms]![Maintain Proposed Schedule]![cmbRunNumber]
End If
If IsNull([Forms]![Maintain Proposed Schedule]![cmbAssignment]) Then
mAssignment = 0
Else
mAssignment = [Forms]![Maintain Proposed Schedule]![cmbAssignment]
End If
If IsNull([Forms]![Maintain Proposed Schedule]![cmbService]) Then
mService = 0
Else
mService = [Forms]![Maintain Proposed Schedule]![cmbService]
End If
sDate = Format(mDate, "yyyy-m-d")
sRun = Trim(Str(mRun))
sAssignment = Trim(Str(mAssignment))
sService = Trim(Str(mService))
'MsgBox "Date " & sDate & " Run " & sRun & " Tot " & Str(Me.txtDASMTotalActRevMiles)
strWhere = "effective_date IS NOT NULL"
Set rst = New ADODB.Recordset
If Not (mDate = #1/1/1900#) Then
strWhere = strWhere & " AND effective_date = '" & sDate & "'"
End If
If Not (mRun = 0) Then
strWhere = strWhere & " AND run_nbr = " & sRun
End If
If Not (mAssignment = 0) Then
strWhere = strWhere & " AND AssignmentTypeId = " & sAssignment
End If
If Not (mService = 0) Then
strWhere = strWhere & " AND service_type = " & sService
End If
With rst
Set .ActiveConnection = CurrentProject.Connection
.Source = "SELECT sum(revenue_miles) as SumRevMiles, " & _
"sum(deadhead_miles) as SumDHMiles, " & _
"sum(revenue_minutes) as SumRevMin, " & _
"sum(deadhead_minutes) as SumDHMin " & _
"from sched_proposed " & _
"WHERE " & strWhere
.CursorLocation = adUseClient
.LockType = adLockReadOnly
.CursorType = adOpenStatic
.Open
[Forms]![Maintain Proposed Schedule]![txtMPSTotRevMiles] = _
.Fields("SumRevMiles")
[Forms]![Maintain Proposed Schedule]![txtMPSTotDHMiles] = _
.Fields("SumDHMiles")
[Forms]![Maintain Proposed Schedule]![txtMPSTotRevMin] = _
.Fields("SumRevMin")
[Forms]![Maintain Proposed Schedule]![txtMPSTotDHMin] = _
.Fields("SumDHMin")
[Forms]![Maintain Proposed Schedule]![txtMPSTotMiles] = _
.Fields("SumRevMiles") + .Fields("SumDHMiles")
.Close
End With
End Function
Public Function DeleteALine(sTable As String, mDate As Date, mRoute As Integer, mRun As Integer, mAssignment As Integer, mService As Integer, mTrip As Integer) As Boolean
Dim sDate As String, sRoute As String, sRun As String, sAssignment As String
Dim sService As String, sTrip As String
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
sDate = Format(mDate, "yyyy-m-d")
sRoute = Trim(Str(mRoute))
sRun = Trim(Str(mRun))
sAssignment = Trim(Str(mAssignment))
sService = Trim(Str(mService))
sTrip = Trim(Str(mTrip))
With rst
Set .ActiveConnection = CurrentProject.Connection
.Source = "Select * from " & sTable & " WHERE effective_date = '" & sDate & "'" & _
" AND route_id = " & sRoute & " AND run_nbr = " & sRun & _
" AND AssignmentTypeId = " & sAssignment & " AND service_type = " & sService & _
" AND trip_nbr >= " & sTrip
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
.Open
.Find "trip_nbr = " & sTrip
If Not .EOF Then
.Delete
.Update
End If
.MoveFirst
Do While Not .EOF
.Fields("trip_nbr") = .Fields("trip_nbr") - 1
.Update
.MoveNext
Loop
End With
rst.Close
Set rst = Nothing
End Function
Public Function ZeroOut(mDate As Date, mRoute As Integer, mRun As Integer, mAssignment As Integer, mService As Integer, mTrip As Integer) As Boolean
Dim sDate As String, sRoute As String, sRun As String, sAssignment As String
Dim sService As String, sTrip As String
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
sDate = Format(mDate, "yyyy-m-d")
sRoute = Trim(Str(mRoute))
sRun = Trim(Str(mRun))
sAssignment = Trim(Str(mAssignment))
sService = Trim(Str(mService))
sTrip = Trim(Str(mTrip))
With rst
Set .ActiveConnection = CurrentProject.Connection
.Source = "Select * from actual_service WHERE effective_date = '" & sDate & "'" & _
" AND route_id = " & sRoute & " AND run_nbr = " & sRun & _
" AND AssignmentTypeId = " & sAssignment & " AND service_type = " & sService & _
" AND trip_nbr = " & sTrip
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
.Open
.Fields("act_revenue_miles") = 0
.Fields("act_deadhead_miles") = 0
.Fields("act_revenue_minutes") = 0
.Fields("act_deadhead_minutes") = 0
.Fields("revenue_miles") = 0
.Fields("deadhead_miles") = 0
.Fields("revenue_minutes") = 0
.Fields("deadhead_minutes") = 0
.Update
End With
rst.Close
Set rst = Nothing
End Function
Public Function ReassignVehicleOld(mDate As Date, _
mRoute As Integer, _
mRun As Integer, _
mAssignment As Integer, _
mService As Integer, _
mTrip As Integer, _
mNewVeh As Integer, _
sTableName As String, _
lTripDown As Boolean) As Boolean
Dim sDate As String, sRoute As String, sRun As String, sAssignment As String
Dim sService As String, sTrip As String, sVehicle As String
Dim sTripDownStr As String
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
sDate = Format(mDate, "yyyy-m-d")
sRoute = Trim(Str(mRoute))
sRun = Trim(Str(mRun))
sAssignment = Trim(Str(mAssignment))
sService = Trim(Str(mService))
sTrip = Trim(Str(mTrip))
If lTripDown Then
sTripDownStr = "AND trip_nbr >= " & sTrip
End If
With rst
Set .ActiveConnection = CurrentProject.Connection
.Source = "Select * from " & sTableName & " WHERE effective_date = '" & sDate & "'" & _
" AND route_id = " & sRoute & " AND run_nbr = " & sRun & _
" AND AssignmentTypeId = " & sAssignment & " AND service_type = " & sService & _
sTripDownStr
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
.Open
.MoveLast
Do While Not .BOF
.Fields("assigned_vehicle") = mNewVeh
.Update
.MovePrevious
Loop
End With
rst.Close
Set rst = Nothing
End Function
Public Function ReassignVehicle(mDate As Date, _
mRoute As Integer, _
mRun As Integer, _
mAssignment As Integer, _
mService As Integer, _
mTrip As Integer, _
mNewVeh As Integer, _
sType As String, _
sTableName As String, _
lTripDown As Boolean) As Boolean
Dim sDate As String, sRoute As String, sRun As String, sAssignment As String
Dim sService As String, sTrip As String, sVehicle As String
Dim sTripDownStr As String
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
sDate = Format(mDate, "yyyy-m-d")
sRoute = Trim(Str(mRoute))
sRun = Trim(Str(mRun))
sAssignment = Trim(Str(mAssignment))
sService = Trim(Str(mService))
sTrip = Trim(Str(mTrip))
If sType = "Date/Run" Then
sStrWhere = " WHERE effective_date = '" & sDate & "'" & _
" AND run_nbr = " & sRun
Else
sStrWhere = " WHERE effective_date = '" & sDate & "'" & _
" AND run_nbr = " & sRun & _
" AND AssignmentTypeId = " & sAssignment & _
" AND service_type = " & sService
End If
If lTripDown Then
sTripDownStr = "AND trip_nbr >= " & sTrip
End If
With rst
Set .ActiveConnection = CurrentProject.Connection
.Source = "Select * from " & sTableName & sStrWhere & _
sTripDownStr
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
.Open
.MoveLast
Do While Not .BOF
.Fields("assigned_vehicle") = mNewVeh
.Update
.MovePrevious
Loop
End With
rst.Close
Set rst = Nothing
End Function
Public Function DeleteRecords(mFromDate As Date, mToDate As Date, sTable As String) As Long
Dim sFromDate As String, sToDate As String, cmd As ADODB.Command
Dim nRecords As Long
sFromDate = Format(mFromDate, "yyyy-m-d")
sToDate = Format(mToDate, "yyyy-m-d")
Set cmd = New ADODB.Command
cmd.ActiveConnection = CurrentProject.Connection
cmd.CommandType = adCmdText
cmd.CommandText = "DELETE FROM " & sTable & _
" WHERE effective_date <= '" & sToDate & "'" & _
" AND effective_date >= '" & sFromDate & "'"
cmd.Execute nRecords
Set cmd = Nothing
DeleteRecords = nRecords
End Function
Public Function CountRecords(mFromDate As Date, mToDate As Date, sTable As String) As Long
Dim sFromDate As String, sToDate As String, cmd As ADODB.Command
Dim nRecords As Long
sFromDate = Format(mFromDate, "yyyy-m-d")
sToDate = Format(mToDate, "yyyy-m-d")
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
With rst
Set .ActiveConnection = CurrentProject.Connection
.Source = "Select * FROM " & sTable & _
" WHERE effective_date <= '" & sToDate & "'" & _
" AND effective_date >= '" & sFromDate & "'"
.CursorLocation = adUseClient
.LockType = adLockReadOnly
.CursorType = adOpenStatic
.Open
CountRecords = .RecordCount
End With
rst.Close
Set rst = Nothing
End Function
Public Function GetHistoryName(mEffDate As Date) As String
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
With rst
Set .ActiveConnection = CurrentProject.Connection
.Source = "Select * from history_names where " & _
"effective_date ='" & Format(mEffDate, "yyyy-m-d") & "'"
.CursorLocation = adUseClient
.LockType = adLockReadOnly
.CursorType = adOpenKeyset
.Open
If .RecordCount > 0 Then
GetHistoryName = .Fields("history_name")
Else
GetHistoryName = ""
End If
End With
rst.Close
Set rst = Nothing
End Function
Public Function DeleteRecordsWhere(sTable As String, strWhere As String) As Long
Dim cmd As ADODB.Command
Dim nRecords As Long
sFromDate = Format(mFromDate, "yyyy-m-d")
sToDate = Format(mToDate, "yyyy-m-d")
Set cmd = New ADODB.Command
cmd.ActiveConnection = CurrentProject.Connection
cmd.CommandType = adCmdText
cmd.CommandText = "DELETE FROM " & sTable & _
" WHERE " & strWhere
cmd.Execute nRecords
Set cmd = Nothing
DeleteRecordsWhere = nRecords
End Function
Public Function CountRecordsWhere(sTable As String, strWhere As String) As Long
Dim cmd As ADODB.Command
Dim nRecords As Long
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
With rst
Set .ActiveConnection = CurrentProject.Connection
.Source = "Select * FROM " & sTable & _
" WHERE " & strWhere
.CursorLocation = adUseClient
.LockType = adLockReadOnly
.CursorType = adOpenStatic
.Open
CountRecordsWhere = .RecordCount
End With
rst.Close
Set rst = Nothing
End Function