variable uses automation type not supported

[eerkut]

Private Type typCateringOrder
conum As Long
Unit As String * 3
periodend As Variant
description As String
headcount As Long
deliverydate As Variant
orderdate As Variant
orderedby As String
orderedfor As String
phonenumber As String
shiptoname As String
shiptoaddress As String
billtoname As String
billtoaddress As String
chargenumber As String
cashorder As Integer
datepaid As Variant
amountpaid As Currency
checknumber As String
price As Currency
tax As Currency
grandtotal As Currency
taxable As Integer
End Type
---------------------------------------
Private Sub ReadCateringOrder(rs As DAO.Recordset, intFile As Integer)
On Error GoTo errFound
Dim CateringOrder As typCateringOrder
Get #intFile, , CateringOrder
If EOF(intFile) Then Exit Sub

rs.AddNew
rs!conum = CateringOrder.conum
rs!Unit = CateringOrder.Unit
rs!periodend = CateringOrder.periodend
rs!description = CateringOrder.description
rs!headcount = CateringOrder.headcount
rs!deliverydate = CateringOrder.deliverydate
rs!orderdate = CateringOrder.orderdate
rs!orderedby = RetNull(CateringOrder.orderedby, " ")
rs!orderedfor = RetNull(CateringOrder.orderedfor, " ")
rs!phonenumber = RetNull(CateringOrder.phonenumber, " ")
rs!shiptoname = RetNull(CateringOrder.shiptoname, " ")
rs!shiptoaddress = RetNull(CateringOrder.shiptoaddress, " ")
rs!billtoname = RetNull(CateringOrder.billtoname, " ")
rs!billtoaddress = RetNull(CateringOrder.billtoaddress, " ")
rs!chargenumber = RetNull(CateringOrder.chargenumber, " ")
rs!cashorder = CateringOrder.cashorder
rs!datepaid = CateringOrder.datepaid


rs!amountpaid = CateringOrder.amountpaid
rs!checknumber = RetNull(CateringOrder.checknumber, " ")
rs!price = CateringOrder.price
rs!tax = CateringOrder.tax
rs!grandtotal = CateringOrder.grandtotal
rs!taxable = CateringOrder.taxable
rs.Update
errFound:
MsgBox Err.description
End Sub
This was a access 2000 database upgraded to 2010 if i take the errfound function it dosent work. with the errfound function pops up a msg box and when i click ok it works HELP Please
variable uses automation type not supported

[orange]

Where do you actually call the Sub? Seems to me there is code involved that isn't being shown.

[eerkut]

I have 11 attachment in the email this program pulls the attachments then reads and writes to database only one attachment keeps having problem.


Private Sub ImportTable(db As Database, strTable As String, strDestTable As String, strFileName As String)
Dim rs As DAO.Recordset
Dim intFile As Integer
Dim strPath As String
Dim lngNumRecords As Long
Dim i As Long

If strRAPLoc = "" Then SetRapLoc
strPath = strRAPLoc & "impexp\"
db.Execute "delete from " & strDestTable, dbFailOnError

Set rs = db.OpenRecordset(strDestTable)

If strFileName = "Payroll" Then
If Dir(strPath & "Payroll2.*") <> "" And db.TableDefs("Payroll").Fields.Count > 13 Then
strFileName = "Payroll2"
End If
End If

intFile = FreeFile
Open strPath & strFileName & "." & gstrFileExt For Binary As intFile

Get #intFile, , lngNumRecords
For i = 1 To lngNumRecords
Select Case strFileName
Case "Period"
Call ReadPeriod(rs, intFile)
Case "District"
Call ReadDistrict(rs, intFile)
Case "State"
Call ReadState(rs, intFile)
Case "City"
Call ReadCity(rs, intFile)
Case "County"
Call ReadCounty(rs, intFile)
Case "CalculationCode"
Call ReadCalculationCode(rs, intFile)
Case "Vendor"
Call ReadVendor(rs, intFile)
Case "GLTypeCode"
Call ReadGLTypeCode(rs, intFile)
Case "GLAccount"
Call ReadGLAccount(rs, intFile)
Case "GLSubAccount"
Call ReadGLSubAccount(rs, intFile)
Case "InventoryCategory"
Call ReadInventoryCategory(rs, intFile)
Case "Unit"
Call ReadUnit(rs, intFile)
Case "UnitVendor"
Call ReadUnitVendor(rs, intFile)
Case "UnitGLAccount"
Call ReadUnitGLAccount(rs, intFile)
Case "ExpenseType"
Call ReadExpenseType(rs, intFile)
Case "LocalSettings"
Call ReadLocalSettings(rs, intFile)
Case "UnitPeriod"
Call ReadUnitPeriod(rs, intFile)
Case "Employee"
Call ReadEmployee(rs, intFile)
Case "Payroll"
Call ReadPayroll(rs, intFile)
Case "Payroll2"
Call ReadPayroll2(rs, intFile)
Case "Purchase"
Call ReadPurchase(rs, intFile)
Case "PurchaseCharge"
Call ReadPurchaseCharge(rs, intFile)
Case "Expense"
Call ReadExpense(rs, intFile)
Case "RegisterCloseout"
Call ReadRegisterCloseout(rs, intFile)
Case "NonRegisterSales"
Call ReadNonRegisterSales(rs, intFile)
Case "FixedExpenses"
Call ReadFixedExpenses(rs, intFile)
Case "Inventory"
Call ReadInventory(rs, intFile)
Case "RegisterType"
Call ReadRegisterType(rs, intFile)
Case "EmpUnit"
Call ReadEmpUnit(rs, intFile)
Case "Register"
Call ReadRegister(rs, intFile)
Case "CateringOrder"
Call ReadCateringOrder(rs, intFile)
Case "CateringOrderItem"
Call ReadCateringOrderItem(rs, intFile)
Case Else
MsgBox "Export definition not found for " & strTable & "."
Err.Raise 100, , "No Export Definition"
End Select
Next i
Close intFile
rs.Close
End Sub

[eerkut]

also is it possible to get morw specific error description and how.

[orange]

Here it is with error handler

Private Sub ImportTable(db As Database, strTable As String, strDestTable As String, strFileName As String)
Dim rs As DAO.Recordset
Dim intFile As Integer
Dim strPath As String
Dim lngNumRecords As Long
Dim i As Long

On Error GoTo ImportTable_Error

If strRAPLoc = "" Then SetRapLoc
strPath = strRAPLoc & "impexp\"
db.Execute "delete from " & strDestTable, dbFailOnError

Set rs = db.OpenRecordset(strDestTable)

If strFileName = "Payroll" Then
If Dir(strPath & "Payroll2.*") <> "" And db.TableDefs("Payroll").Fields.Count > 13 Then
strFileName = "Payroll2"
End If
End If

intFile = FreeFile
Open strPath & strFileName & "." & gstrFileExt For Binary As intFile

Get #intFile, , lngNumRecords
For i = 1 To lngNumRecords
Select Case strFileName
Case "Period"
Call ReadPeriod(rs, intFile)
Case "District"
Call ReadDistrict(rs, intFile)
Case "State"
Call ReadState(rs, intFile)
Case "City"
Call ReadCity(rs, intFile)
Case "County"
Call ReadCounty(rs, intFile)
Case "CalculationCode"
Call ReadCalculationCode(rs, intFile)
Case "Vendor"
Call ReadVendor(rs, intFile)
Case "GLTypeCode"
Call ReadGLTypeCode(rs, intFile)
Case "GLAccount"
Call ReadGLAccount(rs, intFile)
Case "GLSubAccount"
Call ReadGLSubAccount(rs, intFile)
Case "InventoryCategory"
Call ReadInventoryCategory(rs, intFile)
Case "Unit"
Call ReadUnit(rs, intFile)
Case "UnitVendor"
Call ReadUnitVendor(rs, intFile)
Case "UnitGLAccount"
Call ReadUnitGLAccount(rs, intFile)
Case "ExpenseType"
Call ReadExpenseType(rs, intFile)
Case "LocalSettings"
Call ReadLocalSettings(rs, intFile)
Case "UnitPeriod"
Call ReadUnitPeriod(rs, intFile)
Case "Employee"
Call ReadEmployee(rs, intFile)
Case "Payroll"
Call ReadPayroll(rs, intFile)
Case "Payroll2"
Call ReadPayroll2(rs, intFile)
Case "Purchase"
Call ReadPurchase(rs, intFile)
Case "PurchaseCharge"
Call ReadPurchaseCharge(rs, intFile)
Case "Expense"
Call ReadExpense(rs, intFile)
Case "RegisterCloseout"
Call ReadRegisterCloseout(rs, intFile)
Case "NonRegisterSales"
Call ReadNonRegisterSales(rs, intFile)
Case "FixedExpenses"
Call ReadFixedExpenses(rs, intFile)
Case "Inventory"
Call ReadInventory(rs, intFile)
Case "RegisterType"
Call ReadRegisterType(rs, intFile)
Case "EmpUnit"
Call ReadEmpUnit(rs, intFile)
Case "Register"
Call ReadRegister(rs, intFile)
Case "CateringOrder"
Call ReadCateringOrder(rs, intFile)
Case "CateringOrderItem"
Call ReadCateringOrderItem(rs, intFile)
Case Else
MsgBox "Export definition not found for " & strTable & "."
Err.Raise 100, , "No Export Definition"
End Select
Next i
Close intFile
rs.Close

On Error GoTo 0
Exit Sub

ImportTable_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ImportTable "
End Sub