VB error: user defined type not defined 1

[ladyemrys]

Hi!

I have been given a project to update an old Access 2000 adp created by a vendor to Access 2010. It gives the end users various VB errors. When i try to debug it, i get the User defined type not defined error on the following code:

Public Function Add(tag As String, _
Value As String) As TaggedValue

My VB is really bad and i did some preliminary searching, added the microsoft DAO object library to the tools/references section to no avail. Any assistance is much appreciated!

LE

 

[MajP]

Public Function Add(tag As String, _
Value As String) As TaggedValue

This function returns a data type of "taggedValue". That is either a user defined user defined data type or a class module. Somewhere else in the code you should see "taggedValue" defined somewhere. But if it is not ther it cannot find it and it says it is "not defined". Search the code for either a class module called taggedvalue or something like this

public type TaggedValue
someVariable As Variant
someOtherVariable As Variant
...
End Type

If there was a reference to another database the code for this may have existed externally.

 

[ladyemrys]

Thanks MajP i will try that right away! I'll check out any db references as it's made to be the sql front end and to run crystal reports through access. Thanks again, i will report back soon!

LE

 

[ladyemrys]

All I was able to find was this, does that help any? I checked in the functions and there is no mention there of TaggedValue

Public Property Get Text() As String
Dim tv As TaggedValue
Dim strOut As String

' Loop through each item in the collection.
' For any that have non-empty Tag properties
' (and they all really should), tack on the
' Tag=Value pairs.
For Each tv In mcolItems
If Len(tv.tag) > 0 Then
strOut = strOut & mstrSeparator & _
tv.tag & "=" & tv.Value
End If
Next tv
' If there's anything in the output string,
' it'll have a leading separator. Remove that now.
If Len(strOut) > Len(mstrSeparator) Then
strOut = Mid$(strOut, Len(mstrSeparator) + 1)
End If
Text = strOut
End Property


****************
I can upload the whole thing tonight or tomorrow to one of my ftp sites if that would help isolate what's going on better.

Thanks again!
LE

 

[MajP]

The examples you show are places that the data type is used, but not where it is defined. If you do a "find" in the vb window and nothing else comes up, and you do not have a custom class module called taggedData then where did the code go?

1) Did you import all of the old modules? This would be both the old standard modules and the old class modules.
2) Did you delete some code?
3) Was there some references to external databases or dlls that have been broken?

I doubt posting will help. If the code is not there, I cannot tell you what else is missing. The code shows that these taggedValues are contained in a collection which means there is at least some code to populate the collection. If you do not find that, my guess would be there is some significant amount of code that was not imported into your new database.

 

[vbajock]

Your application is using a class module. It's in a file somewhere that usually has a .cls extension. It's a simple text file. You have to re-import it into your new application. It is usually in the same folder your old application was in, with an extension of .cls or .bas. After you find it, copy it into the same folder as your new application, then open the VBA editor, go to the Project Explorer, find Class Modules in your project tree, right click on it, and choose Import, then select the file.

 

[PHV]

All I was able to find
Did you choose the Project radio button in the search box ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[ladyemrys]

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

 

[MajP]

Are you sure that is the class module for the class TaggedValues? Could you have posted the incorrect module? That is not a class module, or if it is it was done by someone who does not no what a class module is. There is no properties and only public functions. Something is not correct. That looks like a standard module. At a minimum the class has to have two get procedures for the properties "Tag" and "Value" because you show them called in your other code.

Go ahead and post your db and I will take a look.

 

[ladyemrys]

Thanks so much! I'll have to check to see what i copied over. It was a module named TaggedValues but I'd have to double check that it was a class module. I'll try to vpn in to work in the morning and pick it up to post. Thanks again for looking at this for me, I really appreciate it.

 

[MajP]

be very specific
you are saying the module is called
TaggedValues
but if it is a class or data type it has to be specifically
TaggedValue

Public Function Add(tag As String, _
Value As String) As TaggedValue

just like in native objects "Form" and "Forms" are two completely different things.

 

[MajP]

If that is not a type than that could possible explain things.

You imported the standard module taggedValues
But you did not import the class TaggedValue (or somehow it is missing)

 

[ladyemrys]

Thanks very much You're absolutely right, if it has an "s" on the end, it will be considered different.

I'll take a very careful look at it on Monday and will also compare it with the working 2007 version to see if there are any differences or if 2010 just tossed something out. I really appreciate your help.

 

[ladyemrys]

Hi MajP,

The Class Module is indeed "TaggedValues", and when comparing it to the older version, it's in there but for some reason it still runs in spite of the debug error (weird). I"m going to see if I can pursue either downgrading the user's Access back to 2007 in the meantime and I'll figure out if i can import everything manually and have it work instead of trying to figure out the consultant's VB code.

Thanks so much for your help on this, you are wonderful.

LE