By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,679 Members | 2,036 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,679 IT Pros & Developers. It's quick & easy.

Building Access Applications "Inventory"

P: n/a
I am trying to copy the inventory database in Building Access Applications
by John L Viescas but when i try to run the database i get an error in the
orders form when i click on the allocate button "Unexpected Error":3251
operation is not supported for this type of object.The demo cd has two
databases, one is called inventory and the other just has the tables for the
design called inventory data. When you run inventory the database works fine
so i thought i would use the tables in the "data" and then import the
queries and forms from the inventory, everything works fine until i want to
allocate products to a customer, i have compared tables in both databases
and they are exact except that the inventory is a linked database, this is
what i think is the problem and the table itself is the tblInventory. Is
there a few people out there who have the book and know what i am doing
wrong or know what to do to make it right
Feb 26 '06 #1
Share this Question
Share on Google+
13 Replies


P: n/a
We need to know a bit more about the procedure that fails.

It it includes this line:
Set rs = db.OpenRecordset("SomeTable")
try:
Set rs = db.OpenRecordset("SomeTable", dbOpenDynaset)

If that does not work, post the line that fails, and any line like the one
above.

OpenRecordset defaults to a Dynaset type for attached tables, but to a Table
type for local tables. If that is the issue, then declaring the Dynaset type
should solve the "operation is not supported for this type of object" error.

--
Allen Browne - Microsoft MVP. Perth, Western Australia.
Tips for Access users - http://allenbrowne.com/tips.html
Reply to group, rather than allenbrowne at mvps dot org.

"royaltiger" <sg*****@ntlworld.com> wrote in message
news:yt*******************@newsfe2-win.ntli.net...
I am trying to copy the inventory database in Building Access Applications
by John L Viescas but when i try to run the database i get an error in the
orders form when i click on the allocate button "Unexpected Error":3251
operation is not supported for this type of object.The demo cd has two
databases, one is called inventory and the other just has the tables for
the design called inventory data. When you run inventory the database works
fine so i thought i would use the tables in the "data" and then import the
queries and forms from the inventory, everything works fine until i want to
allocate products to a customer, i have compared tables in both databases
and they are exact except that the inventory is a linked database, this is
what i think is the problem and the table itself is the tblInventory. Is
there a few people out there who have the book and know what i am doing
wrong or know what to do to make it right

Feb 27 '06 #2

P: n/a
This is the code in the "on click procedure" of the allocate button, there
is also an AllocateProducts function placed in a module if this helps also.
Thanks for trying
Private Sub cmdAllocate_Click()
Dim intReturn As Integer, db As DAO.Database, qdA As DAO.QueryDef, rsA As
DAO.Recordset
' User has requested to allocate / order products
' Set local error trap while trying to put focus back
On Error Resume Next
Screen.PreviousControl.SetFocus
' Set error trap
On Error GoTo cmdAllocate_ERR
' Make sure the last edit is saved
If Not SaveIt() Then Exit Sub
' Point to this database
Set db = DBEngine(0)(0)
' Get the query that find products Status = None
Set qdA = db.QueryDefs("zqryOrderProductSelect")
' Set the parameter for this order
qdA![OrderParm] = CLng(Me.Parent!OrderID)
' See if records found
Set rsA = qdA.OpenRecordset()
' If none, tell them and exit
If rsA.RecordCount = 0 Then
MsgBox "Nothing to allocate.", vbInformation, gstrAppTitle
rsA.Close
Set rsA = Nothing
Exit Sub
End If
rsA.Close
Set rsA = Nothing
' Call the allocate function and pass it this order ID
intReturn = AllocateProducts(CLng(Me.Parent!OrderID))
' Check the return value
Select Case intReturn
' True = All OK
Case -1
' Requery myself to show updated status
Me.Requery
MsgBox "Products allocation completed successfully!",
vbInformation, gstrAppTitle
' False return - some error occurred
Case 0
MsgBox "An error occurred while attempting to allocate Products
for this " & _
"order.", vbExclamation, gstrAppTitle
' 1 = allocated, but built some Purchase Orders
Case 1
MsgBox "Not all Products were in inventory. One or more
purchase orders " & _
"were generated.", vbInformation, gstrAppTitle
End Select

cmdAllocate_Exit:
Exit Sub

cmdAllocate_ERR:
Dim lngErr As Long, strError As String
lngErr = Err
strError = Error
ErrorLog Me.Name & "_cmdAllocate", lngErr, strError
MsgBox "Unexpected error: " & lngErr & ", " & strError & " has been
logged.", _
vbCritical, gstrAppTitle
Resume cmdAllocate_Exit

"Allen Browne" <Al*********@SeeSig.Invalid> wrote in message
news:44***********************@per-qv1-newsreader-01.iinet.net.au...
We need to know a bit more about the procedure that fails.

It it includes this line:
Set rs = db.OpenRecordset("SomeTable")
try:
Set rs = db.OpenRecordset("SomeTable", dbOpenDynaset)

If that does not work, post the line that fails, and any line like the one
above.

OpenRecordset defaults to a Dynaset type for attached tables, but to a
Table type for local tables. If that is the issue, then declaring the
Dynaset type should solve the "operation is not supported for this type of
object" error.

--
Allen Browne - Microsoft MVP. Perth, Western Australia.
Tips for Access users - http://allenbrowne.com/tips.html
Reply to group, rather than allenbrowne at mvps dot org.

"royaltiger" <sg*****@ntlworld.com> wrote in message
news:yt*******************@newsfe2-win.ntli.net...
I am trying to copy the inventory database in Building Access Applications
by John L Viescas but when i try to run the database i get an error in the
orders form when i click on the allocate button "Unexpected Error":3251
operation is not supported for this type of object.The demo cd has two
databases, one is called inventory and the other just has the tables for
the design called inventory data. When you run inventory the database
works fine so i thought i would use the tables in the "data" and then
import the queries and forms from the inventory, everything works fine
until i want to allocate products to a customer, i have compared tables in
both databases and they are exact except that the inventory is a linked
database, this is what i think is the problem and the table itself is the
tblInventory. Is there a few people out there who have the book and know
what i am doing wrong or know what to do to make it right


Feb 27 '06 #3

P: n/a
This is the AllocateProducts function placed in a module called
modInventory.
Option Compare Database 'Use database order for string comparisons
Option Explicit
Dim mlngLineNum As Long, mlngErr As Long, mstrError As String

Function AllocateProducts(lngOrder As Long, _
Optional intSilent As Integer = 0, _
Optional varDate As Variant) As Integer
'
' Inputs: Order ID
' Optional "run silent" indicator (used by zfrmLoadData)
' Optional process date (used by zfrmLoadData)
'
' Output: Returns "True" (-1) if all Products allocated successfully
' Returns +1 if Products allocated and purchase order(s) generated
' Returns "False" (0) if an error occurs
'
' Technique:
' This routine attempts to allocate the required Products.
' Uses "zqryOrderProductSelect" to find Products where Status not
' On Order, Allocated, or Invoiced. If Product is being returned
(negative
' quantity), posts to Inventory or the original PO as appropriate.
' If Product is being ordered (positive quantity), allocates from stock
' in inventory. At end of allocation if some still not allocated from
' inventory, then stuffs the unordered Products in ztTblProductsToOrder
' and calls the common PO build routine.
'
' Note: When called from zfrmLoadData, intSilent is True - procedure will
' open no forms and will not display any errors. zfrmLoadData also
' passes the date it wants to use as the allocation / PODate date.
'
Dim db As DAO.Database, qd As DAO.QueryDef, qdA As DAO.QueryDef
Dim rsA As DAO.Recordset, rsI As DAO.Recordset, rsS As DAO.Recordset
Dim rst As DAO.Recordset, rsP As DAO.Recordset, rsC As DAO.Recordset
Dim varQuantity As Variant, intQuantityReq As Integer
Dim varRet As Variant, intEditA As Integer, intRecCount As Integer
Dim intI As Integer, intSomeError As Integer, intSomeLeft As Integer
Dim intCount As Integer, intQty As Integer, intMult As Integer
Dim intL As Integer, curMinPrice As Currency, curCost As Currency
Dim curPrice As Currency, varCost As Variant, varPrice As Variant
Dim lngPO As Long, lngVendor As Long, intTrans As Integer
Dim lngProductID As Long, lngThisLine As Long, intAddedSome As Integer
Dim intDoPO As Integer, datAllocDate As Date, lngVend As Long
Dim rstW As DAO.Recordset, strSQL As String, strMsg As String

On Error Resume Next
' Set up for default false return
AllocateProducts = 0

' Set up the allocation date
datAllocDate = Date
' If passed a date variable
If Not IsMissing(varDate) Then
' .. and it's a valid date
If IsDate(varDate) Then
' Use the parameter value
datAllocDate = varDate
End If
End If

' Point to this database
Set db = DBEngine(0)(0)
' Open the Order and lock it!
Set rstW = db.OpenRecordset("Select OrderID From tblOrders " & _
"Where OrderID = " & lngOrder)
If rstW.EOF Then
If Not intSilent Then
MsgBox "Unexpected error: Can't find Order #" & _
lngOrder, vbCritical, gstrAppTitle
End If
Exit Function
End If
' Lock the order by editing it
rstW.Edit
If Err <> 0 Then
strMsg = "Error trying to edit Order #" & lngOrder
strMsg = strMsg & ". Someone else may be editing this Order."
If Not intSilent Then MsgBox strMsg, vbExclamation, gstrAppTitle
Exit Function
End If

' Set an error trap
On Error GoTo AllocOrderProducts_ERR

' Clean out working table to store Products not in stock
db.Execute "Delete * FROM zttblProductsToOrder;", dbFailOnError

' Turn on the hourglass and start a transaction
DoCmd.Hourglass True
BeginTrans
intTrans = True

' Open a recordset on Products to allocate
Set qdA = db.QueryDefs("zqryOrderProductSelect")
qdA![OrderParm] = lngOrder
Set rsA = qdA.OpenRecordset()
' Open the inventory table
Set rsI = db.OpenRecordset("tblInventory")

' Get count of Products to allocate rows for SysCmd
rsA.MoveLast
intRecCount = rsA.RecordCount
rsA.MoveFirst

' Show a progress meter
varRet = SysCmd(acSysCmdInitMeter, "Updating Inventory...", intRecCount)

' Loop through all Products to allocate, deduct from stock,
' and adjust master Inventory row
Do Until rsA.EOF
' If returning products, ...
If rsA![AmtNeeded] < 0 Then
' See if return is to a Purchase Order
If IsNothing(rsA!OrderPONo) Then
' If no PO to credit, then return to inventory
intQty = rsA![AmtNeeded]
' Find the inventory record
rsI.FindFirst "ProductID = " & rsA!ProductID
If rsI.NoMatch Then
' Ooops -- can't find the inventory record to return
' the Product!
intSomeError = True
strMsg = "Error attempting to return Product # "
strMsg = strMsg & rsA!ProductID & " to inventory."
strMsg = strMsg & " Inventory record not found."
strMsg = strMsg & " The Order record has been deleted."
If Not intSilent Then MsgBox strMsg, _
vbCritical, gstrAppTitle
' Delete the Order row
rsA.Delete
Else
' Found the Inventory row - edit it to lock it
rsI.Edit
' Find the matching Stock row for an inventory return
strSQL = "Select * From tblStock Where ([ProductID] = "
strSQL = strSQL & rsA!ProductID
strSQL = strSQL & ") And ([Cost] = " & rsA!Cost & ")"
' If there's a VendorID, then also filter for vendor
If Not IsNothing(rsA!VendorID) Then
strSQL = strSQL & " AND ([VendorID] = " & _
rsA!VendorID & ")"
lngVendor = rsA!VendorID
End If
' Open the Stock recordset
Set rsS = db.OpenRecordset(strSQL)
If rsS.EOF Then
' Ooops -- can't find the stock row to return
' the Product!
intSomeError = True
strMsg = "Error attempting to return Product # "
strMsg = strMsg & rsA!ProductID & " to stock."
strMsg = strMsg & " Stock record that matches the "
strMsg = strMsg & "vendor and cost not found."
strMsg = strMsg & " The Order record has been
deleted."
If Not intSilent Then MsgBox strMsg, _
vbCritical, gstrAppTitle
' Delete the Order row
rsA.Delete
Else
' Return the Products to the Stock record
rsS.Edit
' Subtract from Allocated amount -
' product now available back in stock
' NOTE: QuantityAllocated can be negative if
' previously allocated product was already
' invoiced. Will correct when invoiced item
credited.
rsS!QuantityAllocated = rsS!QuantityAllocated + _
rsA!AmtNeeded
rsS!QuantityRemaining = rsS!Quantity - _
(rsS!QuantityAllocated + rsS!QuantitySold + _
rsS!QuantityReturned)
lngVendor = rsS!VendorID
rsS.Update
intQuantityReq = 0
End If
rsS.Close
' Refresh the master inventory totals...
rsI.Edit
' Using a query here so that this routine will
' see the updated quantities within the transaction.
Set qd = db.QueryDefs("zqrySumStockParm")
qd!ItemToFind = rsA!ProductID
Set rst = qd.OpenRecordset()
' Update the calc values in the Inventory row.
If Not rst.EOF Then
rsI!HighCost = rst!MaxCost
rsI!QuantityInStock = rst!Available
rsI!QuantityOnHand = rst!Remain
Else
rsI!QuantityInStock = 0
rsI!QuantityOnHand = 0
End If
rst.Close
Set rst = Nothing
qd.Close
Set qd = Nothing
rsI.Update

' Update the Order status
rsA.Edit
rsA!Status = OrderStatus.Allocated
rsA!DateAlloc = datAllocDate
rsA!VendorID = lngVendor
rsA.Update
End If
Else
' There's a PO Number, so credit back to the PO!
' Open a recordset on PO Products to insert the row
Set rsP = db.OpenRecordset("zqryPOProductsForAlloc", _
dbOpenDynaset, dbAppendOnly)
' Insert a new PO Product row to queue up the credit
' Get "next" line no --
' must use recordset inside a transaction!
Set rsC = db.OpenRecordset("Select Max([LineNo]) As
[LastLineNo] " & _
"From tblPOProducts " & _
"Where [PONumber] = " & rsA!OrderPONo)
If IsNull(rsC!LastLineNo) Then
intL = 1
Else
intL = rsC!LastLineNo + 1
End If
rsC.Close
rsP.AddNew
rsP!PONumber = rsA!OrderPONo
' Setting the PO Number should "autolookup"
' the Vendor ID from the PO
If IsNothing(rsP!POVend) Then
' Ooops - means the PO does not exist!
If Not intSilent Then
MsgBox "Error attempting to credit product # " & _
rsA!ProductID & " to purchase order # " &
rsA!OrderPONo & _
". The Purchase Order cannot be found. " & _
"The PO Number in the Order has been zeroed.", _
vbCritical, gstrAppTitle
End If
intSomeError = True
rsA.Edit
' Zero out the PO Number
rsA!OrderPONumber = 0
rsA.Update
' Discard the POProduct row
rsP.Close
Set rsP = Nothing
Else
' OK - have a good PO, so set the rest of the fields
rsP!LineNo = intL
' copy Vendor ID from the Purchase Order
rsP!VendorID = rsP!POVend
lngVendor = rsP!POVend
' Copy the Product ID
rsP!ProductID = rsA!ProductID
' Save the quantity required
intQty = rsA![AmtNeeded]
' .. and the order multiple
' (number of sell units in one purchase unit)
intMult = rsA![OrderMultiple]
' Set the return quantity
rsP!SellQuantity = intQty
' If the quantity is an even multiple
If intQty Mod intMult = 0 Then
' Do an integer divide to get the amount to order
rsP!BuyQuantity = intQty \ intMult
Else
' else round up to the next buy amount
rsP!BuyQuantity = (intQty \ intMult) + 1
End If
' Set the order by ("case", "pallet")
rsP!OrderBy = rsA![OrderBy]
' Set the sell by ("each", "case")
rsP!SellBy = rsA![SellBy]
' Set the order multiple
rsP!OrderMultiple = intMult
' Use the vendor cost
rsP!Cost = rsP!VendCost
' Use price from the order
rsP!Price = rsA!Price
' Save the new PO Product row
rsP.Update
rsP.Close
Set rsP = Nothing
' Update the Order status
rsA.Edit
' Put the vendor we found in the order
rsA!VendorID = lngVendor
' Set the related PO line number
rsA!OrderPOLineNo = intL
' Mark the status "on order"
rsA!Status = OrderStatus.OnOrder
rsA.Update
' Finally, get the PO and unset its Completed flag
db.Execute ("Update tblPurchaseOrders " & _
"Set [Completed] = False " & _
"Where [PONumber] = " & rsA!OrderPONo)
End If
End If
' End of code to process returns
Else
' Start of code to process positive allocations
' Quantity is positive -- go try to allocate from inventory
intQuantityReq = rsA!AmtNeeded
' Find the Product in the master inventory table
rsI.FindFirst "ProductID = " & rsA!ProductID
If Not rsI.NoMatch Then
' We found the inventory row -- check for quantity available
If rsI!QuantityOnHand > 0 Then
' Looks like some in stock,
' so open a recordset on the stock rows
strSQL = "Select * From tblStock"
strSQL = strSQL & " Where [ProductID] = " &
rsA!ProductID
strSQL = strSQL & " AND QuantityRemaining > 0"
strSQL = strSQL & " ORDER BY [DateReceived]"
' Recordset plucks off the oldest rows first
Set rsS = db.OpenRecordset(strSQL)
If Not rsS.EOF Then
rsS.Edit
' If this stock record has enough, then ...
If intQuantityReq <= rsS!QuantityRemaining Then
' .. pluck the Products from this stock row and
we're done
' Add the quantity needed to Stock Allocated
rsS!QuantityAllocated = rsS!QuantityAllocated +
_
intQuantityReq
' Reduce quantity remaining by quantity needed
rsS!QuantityRemaining = rsS!QuantityRemaining -
_
intQuantityReq
' Save the record
rsS.Update
' Got it all - set required to zero
intQuantityReq = 0
Else
' .. otherwise, grab what's available
' Take whatever is remaining and add it to
allocated
rsS!QuantityAllocated = rsS!QuantityAllocated +
_
rsS!QuantityRemaining
' Reduce required by amount that was remaining
intQuantityReq = intQuantityReq - _
rsS!QuantityRemaining
' Set remaining to zero
rsS!QuantityRemaining = 0
' Save the record
rsS.Update
End If
' Save the cost for updating the Order row
curCost = rsS!Cost
' Save the vendor ID for updating the Order row
lngVendor = rsS!VendorID
rsS.Close
' We're going to update the Order, so edit the row
rsA.Edit
' Update the Order with what we found in stock...
' If quantity remaining, then this will
' reduce the original quantity
rsA!AmtNeeded = (rsA!AmtNeeded - intQuantityReq)
' Set in the allocated found cost
rsA!Cost = curCost
' Set this amount allocated
rsA!Status = OrderStatus.Allocated
' Set the allocation date
rsA!DateAlloc = datAllocDate
' Update the Vendor ID
rsA!VendorID = lngVendor
' Save the Order record
rsA.Update
' Refresh the master inventory totals...
rsI.Edit
' Using a query here so that this routine '
' will see the updated quantities
' within the transaction.
Set qd = db.QueryDefs("zqrySumStockParm")
qd!ItemToFind = rsA!ProductID
Set rst = qd.OpenRecordset()
' Update the "unnormalized" calc values
' in the Inventory row.
If Not rst.EOF Then
rsI!HighCost = rst!MaxCost
rsI!QuantityInStock = rst!Available
rsI!QuantityOnHand = rst!Remain
Else
rsI!QuantityInStock = 0
rsI!QuantityOnHand = 0
End If
rst.Close
qd.Close
' Update the inventory master
rsI.Update
End If
End If
End If
' See if any remaining to allocate
If intQuantityReq > 0 Then
' Did we allocate any on the current row?
If rsA!Status = OrderStatus.Allocated Then
' Yes - need to create a new row
' with remaining quantity!
' Save the line number to get back
lngThisLine = rsA!LineNo
' Save values for new row
lngProductID = rsA!ProductID
curCost = rsA!Cost
curPrice = rsA!Price
' Now, add a new Order row!
' This is a cool trick in DAO - the new row will come up
for
' processing at the end of the current recordset, so
we'll
' keep looking for available Stock records at other
costs until
' we either allocate all requested or end up with a
left over
' amount to stuff in a Purchase Order.
rsA.AddNew
intAddedSome = True
' Set the order ID
rsA!OrderID = lngOrder
' Use a query to find the current largest line number
Set rst = db.OpenRecordset("Select Max([LineNo]) As
MaxLine " & _
"From tblOrderProducts Where [OrderID] = " &
lngOrder)
rsA!LineNo = rst![MaxLine] + 1
rst.Close
' Set up Product ID, quantity, and prices
rsA!ProductID = lngProductID
rsA!Cost = curCost
rsA!Price = curPrice
rsA!AmtNeeded = intQuantityReq
rsA!Status = OrderStatus.None
' Save the new Order Products row with
' remaining unallocated amount
rsA.Update
' Reposition on the original line number to '
' continue processing!
rsA.FindFirst "[LineNo] = " & lngThisLine
If rsA.NoMatch Then ' Should not occur!
Error 3999
End If
End If
End If
End If
' Finished processing the current Order record - get the next
rsA.MoveNext
intI = intI + 1
' Update the status meter
varRet = SysCmd(acSysCmdUpdateMeter, intI)
Loop
' Done with all Order rows - clear the status bar
varRet = SysCmd(acSysCmdClearStatus)
' Commit what we've done
CommitTrans
intTrans = False
' Close off recordsets
rsA.Close
Set rsA = Nothing
rsI.Close
Set rsI = Nothing
rstW.Close
Set rstW = Nothing
' Turn off the hourglass
DoCmd.Hourglass False
' If got no warnings, then set up to return success
If Not (intSomeError) Then AllocateProducts = True
' If we added some Order rows
If (intAddedSome = True) Then
' If Order form loaded (it should be, but just checking)
If IsFormLoaded("frmOrders") Then
' Requery the subform
Forms!frmOrders!fsubOrderProducts.Requery
End If
End If
' See if any left unallocated - run the "append leftovers" query
Set qd = db.QueryDefs("zqappOrderProductsToOrder")
qd![OrderParm] = lngOrder
qd.Execute
' See if there are any rows
If DCount("*", "ztTblProductsToOrder") <> 0 Then
' Yes - set a flag
intSomeLeft = True
' Ask if user wants to create Purchase Orders
' But auto-create PO if called from zfrmLoadData
If intSilent Then
intDoPO = vbYes
Else
intDoPO = MsgBox("Insufficient stock in inventory for one " & _
"or more Products required for this order. " & _
"Do you want to generate purchase orders for this order?", _
vbQuestion + vbYesNo, gstrAppTitle)
End If
If intDoPO = vbYes Then
' Turn off local error trapping
On Error GoTo 0
' Call the Product PO generator - pass the silent flag
If GenProductsPO(lngOrder, intSilent, datAllocDate) Then
' Indicate Purchase Orders created
AllocateProducts = 1
intSomeLeft = False
End If
End If
End If
If (intSomeLeft = True) Then
If Not intSilent Then MsgBox "Some Products were not allocated, " &
_
"but you cancelled PO creation.", vbInformation, gstrAppTitle
End If

' Let the DBEngine catch up with all this work
DBEngine.Idle dbFreeLocks

' Done
Exit Function

AllocOrderProducts_ERR:
' Display and log any errors
If Not intSilent Then MsgBox "Unexpected Error: " & Err & _
", " & Error, vbCritical, gstrAppTitle
ErrorLog "AllocateProducts", Err, Error
On Error Resume Next
' If a transaction was started, roll it back
If (intTrans = True) Then Rollback
' Clear the status bar
varRet = SysCmd(acSysCmdClearStatus)
' Turn off the hourglass
DoCmd.Hourglass False
' Bail!
Exit Function

End Function

End Sub

"Allen Browne" <Al*********@SeeSig.Invalid> wrote in message
news:44***********************@per-qv1-newsreader-01.iinet.net.au...
We need to know a bit more about the procedure that fails.

It it includes this line:
Set rs = db.OpenRecordset("SomeTable")
try:
Set rs = db.OpenRecordset("SomeTable", dbOpenDynaset)

If that does not work, post the line that fails, and any line like the one
above.

OpenRecordset defaults to a Dynaset type for attached tables, but to a
Table type for local tables. If that is the issue, then declaring the
Dynaset type should solve the "operation is not supported for this type of
object" error.

--
Allen Browne - Microsoft MVP. Perth, Western Australia.
Tips for Access users - http://allenbrowne.com/tips.html
Reply to group, rather than allenbrowne at mvps dot org.

"royaltiger" <sg*****@ntlworld.com> wrote in message
news:yt*******************@newsfe2-win.ntli.net...
I am trying to copy the inventory database in Building Access Applications
by John L Viescas but when i try to run the database i get an error in the
orders form when i click on the allocate button "Unexpected Error":3251
operation is not supported for this type of object.The demo cd has two
databases, one is called inventory and the other just has the tables for
the design called inventory data. When you run inventory the database
works fine so i thought i would use the tables in the "data" and then
import the queries and forms from the inventory, everything works fine
until i want to allocate products to a customer, i have compared tables in
both databases and they are exact except that the inventory is a linked
database, this is what i think is the problem and the table itself is the
tblInventory. Is there a few people out there who have the book and know
what i am doing wrong or know what to do to make it right


Feb 27 '06 #4

P: n/a
And which line generates the error?

--
Allen Browne - Microsoft MVP. Perth, Western Australia.
Tips for Access users - http://allenbrowne.com/tips.html
Reply to group, rather than allenbrowne at mvps dot org.

"royaltiger" <sg*****@ntlworld.com> wrote in message
news:_x*******************@newsfe7-win.ntli.net...
This is the AllocateProducts function placed in a module called
modInventory.
Option Compare Database 'Use database order for string comparisons
Option Explicit
Dim mlngLineNum As Long, mlngErr As Long, mstrError As String

Function AllocateProducts(lngOrder As Long, _
Optional intSilent As Integer = 0, _
Optional varDate As Variant) As Integer
'
' Inputs: Order ID
' Optional "run silent" indicator (used by zfrmLoadData)
' Optional process date (used by zfrmLoadData)
'
' Output: Returns "True" (-1) if all Products allocated successfully
' Returns +1 if Products allocated and purchase order(s) generated
' Returns "False" (0) if an error occurs
'
' Technique:
' This routine attempts to allocate the required Products.
' Uses "zqryOrderProductSelect" to find Products where Status not
' On Order, Allocated, or Invoiced. If Product is being returned
(negative
' quantity), posts to Inventory or the original PO as appropriate.
' If Product is being ordered (positive quantity), allocates from stock
' in inventory. At end of allocation if some still not allocated from
' inventory, then stuffs the unordered Products in ztTblProductsToOrder
' and calls the common PO build routine.
'
' Note: When called from zfrmLoadData, intSilent is True - procedure will
' open no forms and will not display any errors. zfrmLoadData also
' passes the date it wants to use as the allocation / PODate date.
'
Dim db As DAO.Database, qd As DAO.QueryDef, qdA As DAO.QueryDef
Dim rsA As DAO.Recordset, rsI As DAO.Recordset, rsS As DAO.Recordset
Dim rst As DAO.Recordset, rsP As DAO.Recordset, rsC As DAO.Recordset
Dim varQuantity As Variant, intQuantityReq As Integer
Dim varRet As Variant, intEditA As Integer, intRecCount As Integer
Dim intI As Integer, intSomeError As Integer, intSomeLeft As Integer
Dim intCount As Integer, intQty As Integer, intMult As Integer
Dim intL As Integer, curMinPrice As Currency, curCost As Currency
Dim curPrice As Currency, varCost As Variant, varPrice As Variant
Dim lngPO As Long, lngVendor As Long, intTrans As Integer
Dim lngProductID As Long, lngThisLine As Long, intAddedSome As Integer
Dim intDoPO As Integer, datAllocDate As Date, lngVend As Long
Dim rstW As DAO.Recordset, strSQL As String, strMsg As String

On Error Resume Next
' Set up for default false return
AllocateProducts = 0

' Set up the allocation date
datAllocDate = Date
' If passed a date variable
If Not IsMissing(varDate) Then
' .. and it's a valid date
If IsDate(varDate) Then
' Use the parameter value
datAllocDate = varDate
End If
End If

' Point to this database
Set db = DBEngine(0)(0)
' Open the Order and lock it!
Set rstW = db.OpenRecordset("Select OrderID From tblOrders " & _
"Where OrderID = " & lngOrder)
If rstW.EOF Then
If Not intSilent Then
MsgBox "Unexpected error: Can't find Order #" & _
lngOrder, vbCritical, gstrAppTitle
End If
Exit Function
End If
' Lock the order by editing it
rstW.Edit
If Err <> 0 Then
strMsg = "Error trying to edit Order #" & lngOrder
strMsg = strMsg & ". Someone else may be editing this Order."
If Not intSilent Then MsgBox strMsg, vbExclamation, gstrAppTitle
Exit Function
End If

' Set an error trap
On Error GoTo AllocOrderProducts_ERR

' Clean out working table to store Products not in stock
db.Execute "Delete * FROM zttblProductsToOrder;", dbFailOnError

' Turn on the hourglass and start a transaction
DoCmd.Hourglass True
BeginTrans
intTrans = True

' Open a recordset on Products to allocate
Set qdA = db.QueryDefs("zqryOrderProductSelect")
qdA![OrderParm] = lngOrder
Set rsA = qdA.OpenRecordset()
' Open the inventory table
Set rsI = db.OpenRecordset("tblInventory")

' Get count of Products to allocate rows for SysCmd
rsA.MoveLast
intRecCount = rsA.RecordCount
rsA.MoveFirst

' Show a progress meter
varRet = SysCmd(acSysCmdInitMeter, "Updating Inventory...",
intRecCount)

' Loop through all Products to allocate, deduct from stock,
' and adjust master Inventory row
Do Until rsA.EOF
' If returning products, ...
If rsA![AmtNeeded] < 0 Then
' See if return is to a Purchase Order
If IsNothing(rsA!OrderPONo) Then
' If no PO to credit, then return to inventory
intQty = rsA![AmtNeeded]
' Find the inventory record
rsI.FindFirst "ProductID = " & rsA!ProductID
If rsI.NoMatch Then
' Ooops -- can't find the inventory record to return
' the Product!
intSomeError = True
strMsg = "Error attempting to return Product # "
strMsg = strMsg & rsA!ProductID & " to inventory."
strMsg = strMsg & " Inventory record not found."
strMsg = strMsg & " The Order record has been
deleted."
If Not intSilent Then MsgBox strMsg, _
vbCritical, gstrAppTitle
' Delete the Order row
rsA.Delete
Else
' Found the Inventory row - edit it to lock it
rsI.Edit
' Find the matching Stock row for an inventory return
strSQL = "Select * From tblStock Where ([ProductID] = "
strSQL = strSQL & rsA!ProductID
strSQL = strSQL & ") And ([Cost] = " & rsA!Cost & ")"
' If there's a VendorID, then also filter for vendor
If Not IsNothing(rsA!VendorID) Then
strSQL = strSQL & " AND ([VendorID] = " & _
rsA!VendorID & ")"
lngVendor = rsA!VendorID
End If
' Open the Stock recordset
Set rsS = db.OpenRecordset(strSQL)
If rsS.EOF Then
' Ooops -- can't find the stock row to return
' the Product!
intSomeError = True
strMsg = "Error attempting to return Product # "
strMsg = strMsg & rsA!ProductID & " to stock."
strMsg = strMsg & " Stock record that matches the
"
strMsg = strMsg & "vendor and cost not found."
strMsg = strMsg & " The Order record has been
deleted."
If Not intSilent Then MsgBox strMsg, _
vbCritical, gstrAppTitle
' Delete the Order row
rsA.Delete
Else
' Return the Products to the Stock record
rsS.Edit
' Subtract from Allocated amount -
' product now available back in stock
' NOTE: QuantityAllocated can be negative if
' previously allocated product was already
' invoiced. Will correct when invoiced item
credited.
rsS!QuantityAllocated = rsS!QuantityAllocated + _
rsA!AmtNeeded
rsS!QuantityRemaining = rsS!Quantity - _
(rsS!QuantityAllocated + rsS!QuantitySold + _
rsS!QuantityReturned)
lngVendor = rsS!VendorID
rsS.Update
intQuantityReq = 0
End If
rsS.Close
' Refresh the master inventory totals...
rsI.Edit
' Using a query here so that this routine will
' see the updated quantities within the transaction.
Set qd = db.QueryDefs("zqrySumStockParm")
qd!ItemToFind = rsA!ProductID
Set rst = qd.OpenRecordset()
' Update the calc values in the Inventory row.
If Not rst.EOF Then
rsI!HighCost = rst!MaxCost
rsI!QuantityInStock = rst!Available
rsI!QuantityOnHand = rst!Remain
Else
rsI!QuantityInStock = 0
rsI!QuantityOnHand = 0
End If
rst.Close
Set rst = Nothing
qd.Close
Set qd = Nothing
rsI.Update

' Update the Order status
rsA.Edit
rsA!Status = OrderStatus.Allocated
rsA!DateAlloc = datAllocDate
rsA!VendorID = lngVendor
rsA.Update
End If
Else
' There's a PO Number, so credit back to the PO!
' Open a recordset on PO Products to insert the row
Set rsP = db.OpenRecordset("zqryPOProductsForAlloc", _
dbOpenDynaset, dbAppendOnly)
' Insert a new PO Product row to queue up the credit
' Get "next" line no --
' must use recordset inside a transaction!
Set rsC = db.OpenRecordset("Select Max([LineNo]) As
[LastLineNo] " & _
"From tblPOProducts " & _
"Where [PONumber] = " & rsA!OrderPONo)
If IsNull(rsC!LastLineNo) Then
intL = 1
Else
intL = rsC!LastLineNo + 1
End If
rsC.Close
rsP.AddNew
rsP!PONumber = rsA!OrderPONo
' Setting the PO Number should "autolookup"
' the Vendor ID from the PO
If IsNothing(rsP!POVend) Then
' Ooops - means the PO does not exist!
If Not intSilent Then
MsgBox "Error attempting to credit product # " & _
rsA!ProductID & " to purchase order # " &
rsA!OrderPONo & _
". The Purchase Order cannot be found. " & _
"The PO Number in the Order has been zeroed.", _
vbCritical, gstrAppTitle
End If
intSomeError = True
rsA.Edit
' Zero out the PO Number
rsA!OrderPONumber = 0
rsA.Update
' Discard the POProduct row
rsP.Close
Set rsP = Nothing
Else
' OK - have a good PO, so set the rest of the fields
rsP!LineNo = intL
' copy Vendor ID from the Purchase Order
rsP!VendorID = rsP!POVend
lngVendor = rsP!POVend
' Copy the Product ID
rsP!ProductID = rsA!ProductID
' Save the quantity required
intQty = rsA![AmtNeeded]
' .. and the order multiple
' (number of sell units in one purchase unit)
intMult = rsA![OrderMultiple]
' Set the return quantity
rsP!SellQuantity = intQty
' If the quantity is an even multiple
If intQty Mod intMult = 0 Then
' Do an integer divide to get the amount to order
rsP!BuyQuantity = intQty \ intMult
Else
' else round up to the next buy amount
rsP!BuyQuantity = (intQty \ intMult) + 1
End If
' Set the order by ("case", "pallet")
rsP!OrderBy = rsA![OrderBy]
' Set the sell by ("each", "case")
rsP!SellBy = rsA![SellBy]
' Set the order multiple
rsP!OrderMultiple = intMult
' Use the vendor cost
rsP!Cost = rsP!VendCost
' Use price from the order
rsP!Price = rsA!Price
' Save the new PO Product row
rsP.Update
rsP.Close
Set rsP = Nothing
' Update the Order status
rsA.Edit
' Put the vendor we found in the order
rsA!VendorID = lngVendor
' Set the related PO line number
rsA!OrderPOLineNo = intL
' Mark the status "on order"
rsA!Status = OrderStatus.OnOrder
rsA.Update
' Finally, get the PO and unset its Completed flag
db.Execute ("Update tblPurchaseOrders " & _
"Set [Completed] = False " & _
"Where [PONumber] = " & rsA!OrderPONo)
End If
End If
' End of code to process returns
Else
' Start of code to process positive allocations
' Quantity is positive -- go try to allocate from inventory
intQuantityReq = rsA!AmtNeeded
' Find the Product in the master inventory table
rsI.FindFirst "ProductID = " & rsA!ProductID
If Not rsI.NoMatch Then
' We found the inventory row -- check for quantity
available
If rsI!QuantityOnHand > 0 Then
' Looks like some in stock,
' so open a recordset on the stock rows
strSQL = "Select * From tblStock"
strSQL = strSQL & " Where [ProductID] = " &
rsA!ProductID
strSQL = strSQL & " AND QuantityRemaining > 0"
strSQL = strSQL & " ORDER BY [DateReceived]"
' Recordset plucks off the oldest rows first
Set rsS = db.OpenRecordset(strSQL)
If Not rsS.EOF Then
rsS.Edit
' If this stock record has enough, then ...
If intQuantityReq <= rsS!QuantityRemaining Then
' .. pluck the Products from this stock row and
we're done
' Add the quantity needed to Stock Allocated
rsS!QuantityAllocated = rsS!QuantityAllocated +
_
intQuantityReq
' Reduce quantity remaining by quantity needed
rsS!QuantityRemaining = rsS!QuantityRemaining -
_
intQuantityReq
' Save the record
rsS.Update
' Got it all - set required to zero
intQuantityReq = 0
Else
' .. otherwise, grab what's available
' Take whatever is remaining and add it to
allocated
rsS!QuantityAllocated = rsS!QuantityAllocated +
_
rsS!QuantityRemaining
' Reduce required by amount that was remaining
intQuantityReq = intQuantityReq - _
rsS!QuantityRemaining
' Set remaining to zero
rsS!QuantityRemaining = 0
' Save the record
rsS.Update
End If
' Save the cost for updating the Order row
curCost = rsS!Cost
' Save the vendor ID for updating the Order row
lngVendor = rsS!VendorID
rsS.Close
' We're going to update the Order, so edit the row
rsA.Edit
' Update the Order with what we found in stock...
' If quantity remaining, then this will
' reduce the original quantity
rsA!AmtNeeded = (rsA!AmtNeeded - intQuantityReq)
' Set in the allocated found cost
rsA!Cost = curCost
' Set this amount allocated
rsA!Status = OrderStatus.Allocated
' Set the allocation date
rsA!DateAlloc = datAllocDate
' Update the Vendor ID
rsA!VendorID = lngVendor
' Save the Order record
rsA.Update
' Refresh the master inventory totals...
rsI.Edit
' Using a query here so that this routine '
' will see the updated quantities
' within the transaction.
Set qd = db.QueryDefs("zqrySumStockParm")
qd!ItemToFind = rsA!ProductID
Set rst = qd.OpenRecordset()
' Update the "unnormalized" calc values
' in the Inventory row.
If Not rst.EOF Then
rsI!HighCost = rst!MaxCost
rsI!QuantityInStock = rst!Available
rsI!QuantityOnHand = rst!Remain
Else
rsI!QuantityInStock = 0
rsI!QuantityOnHand = 0
End If
rst.Close
qd.Close
' Update the inventory master
rsI.Update
End If
End If
End If
' See if any remaining to allocate
If intQuantityReq > 0 Then
' Did we allocate any on the current row?
If rsA!Status = OrderStatus.Allocated Then
' Yes - need to create a new row
' with remaining quantity!
' Save the line number to get back
lngThisLine = rsA!LineNo
' Save values for new row
lngProductID = rsA!ProductID
curCost = rsA!Cost
curPrice = rsA!Price
' Now, add a new Order row!
' This is a cool trick in DAO - the new row will come
up
for
' processing at the end of the current recordset, so
we'll
' keep looking for available Stock records at other
costs until
' we either allocate all requested or end up with a
left over
' amount to stuff in a Purchase Order.
rsA.AddNew
intAddedSome = True
' Set the order ID
rsA!OrderID = lngOrder
' Use a query to find the current largest line number
Set rst = db.OpenRecordset("Select Max([LineNo]) As
MaxLine " & _
"From tblOrderProducts Where [OrderID] = " &
lngOrder)
rsA!LineNo = rst![MaxLine] + 1
rst.Close
' Set up Product ID, quantity, and prices
rsA!ProductID = lngProductID
rsA!Cost = curCost
rsA!Price = curPrice
rsA!AmtNeeded = intQuantityReq
rsA!Status = OrderStatus.None
' Save the new Order Products row with
' remaining unallocated amount
rsA.Update
' Reposition on the original line number to '
' continue processing!
rsA.FindFirst "[LineNo] = " & lngThisLine
If rsA.NoMatch Then ' Should not occur!
Error 3999
End If
End If
End If
End If
' Finished processing the current Order record - get the next
rsA.MoveNext
intI = intI + 1
' Update the status meter
varRet = SysCmd(acSysCmdUpdateMeter, intI)
Loop
' Done with all Order rows - clear the status bar
varRet = SysCmd(acSysCmdClearStatus)
' Commit what we've done
CommitTrans
intTrans = False
' Close off recordsets
rsA.Close
Set rsA = Nothing
rsI.Close
Set rsI = Nothing
rstW.Close
Set rstW = Nothing
' Turn off the hourglass
DoCmd.Hourglass False
' If got no warnings, then set up to return success
If Not (intSomeError) Then AllocateProducts = True
' If we added some Order rows
If (intAddedSome = True) Then
' If Order form loaded (it should be, but just checking)
If IsFormLoaded("frmOrders") Then
' Requery the subform
Forms!frmOrders!fsubOrderProducts.Requery
End If
End If
' See if any left unallocated - run the "append leftovers" query
Set qd = db.QueryDefs("zqappOrderProductsToOrder")
qd![OrderParm] = lngOrder
qd.Execute
' See if there are any rows
If DCount("*", "ztTblProductsToOrder") <> 0 Then
' Yes - set a flag
intSomeLeft = True
' Ask if user wants to create Purchase Orders
' But auto-create PO if called from zfrmLoadData
If intSilent Then
intDoPO = vbYes
Else
intDoPO = MsgBox("Insufficient stock in inventory for one " & _
"or more Products required for this order. " & _
"Do you want to generate purchase orders for this order?",
_
vbQuestion + vbYesNo, gstrAppTitle)
End If
If intDoPO = vbYes Then
' Turn off local error trapping
On Error GoTo 0
' Call the Product PO generator - pass the silent flag
If GenProductsPO(lngOrder, intSilent, datAllocDate) Then
' Indicate Purchase Orders created
AllocateProducts = 1
intSomeLeft = False
End If
End If
End If
If (intSomeLeft = True) Then
If Not intSilent Then MsgBox "Some Products were not allocated, " &
_
"but you cancelled PO creation.", vbInformation, gstrAppTitle
End If

' Let the DBEngine catch up with all this work
DBEngine.Idle dbFreeLocks

' Done
Exit Function

AllocOrderProducts_ERR:
' Display and log any errors
If Not intSilent Then MsgBox "Unexpected Error: " & Err & _
", " & Error, vbCritical, gstrAppTitle
ErrorLog "AllocateProducts", Err, Error
On Error Resume Next
' If a transaction was started, roll it back
If (intTrans = True) Then Rollback
' Clear the status bar
varRet = SysCmd(acSysCmdClearStatus)
' Turn off the hourglass
DoCmd.Hourglass False
' Bail!
Exit Function

End Function

End Sub

"Allen Browne" <Al*********@SeeSig.Invalid> wrote in message
news:44***********************@per-qv1-newsreader-01.iinet.net.au...
We need to know a bit more about the procedure that fails.

It it includes this line:
Set rs = db.OpenRecordset("SomeTable")
try:
Set rs = db.OpenRecordset("SomeTable", dbOpenDynaset)

If that does not work, post the line that fails, and any line like the
one above.

OpenRecordset defaults to a Dynaset type for attached tables, but to a
Table type for local tables. If that is the issue, then declaring the
Dynaset type should solve the "operation is not supported for this type
of object" error.

"royaltiger" <sg*****@ntlworld.com> wrote in message
news:yt*******************@newsfe2-win.ntli.net...
I am trying to copy the inventory database in Building Access
Applications by John L Viescas but when i try to run the database i get
an error in the orders form when i click on the allocate button
"Unexpected Error":3251 operation is not supported for this type of
object.The demo cd has two databases, one is called inventory and the
other just has the tables for the design called inventory data. When you
run inventory the database works fine so i thought i would use the tables
in the "data" and then import the queries and forms from the inventory,
everything works fine until i want to allocate products to a customer, i
have compared tables in both databases and they are exact except that the
inventory is a linked database, this is what i think is the problem and
the table itself is the tblInventory. Is there a few people out there who
have the book and know what i am doing wrong or know what to do to make
it right



Feb 27 '06 #5

P: n/a
This is where i am confused, when i click on the allocate button all i get
is Unexpected Error:3251 operation is not supported for this type of object
so i click ok then error trap code says an error occured while attempting to
AllocateProducts for this order, and again i click ok, if you mean does it
open into visual basic and halt on a line it does not, it stays with the
order form.I also dont understand what linked tables are about only that i
cant alter any properties in design mode which is what i need to adjust to
my liking which is where i think is a problem, if i click on file, Get
Externel Data and import just the one table called tblInventory the program
works but it is a linked table whilst all others are normal.If i then copy
the table and paste keeping structure database stops woking again
"Allen Browne" <Al*********@SeeSig.Invalid> wrote in message
news:44***********************@per-qv1-newsreader-01.iinet.net.au...
And which line generates the error?

--
Allen Browne - Microsoft MVP. Perth, Western Australia.
Tips for Access users - http://allenbrowne.com/tips.html
Reply to group, rather than allenbrowne at mvps dot org.

"royaltiger" <sg*****@ntlworld.com> wrote in message
news:_x*******************@newsfe7-win.ntli.net...
This is the AllocateProducts function placed in a module called
modInventory.
Option Compare Database 'Use database order for string comparisons
Option Explicit
Dim mlngLineNum As Long, mlngErr As Long, mstrError As String

Function AllocateProducts(lngOrder As Long, _
Optional intSilent As Integer = 0, _
Optional varDate As Variant) As Integer
'
' Inputs: Order ID
' Optional "run silent" indicator (used by zfrmLoadData)
' Optional process date (used by zfrmLoadData)
'
' Output: Returns "True" (-1) if all Products allocated successfully
' Returns +1 if Products allocated and purchase order(s)
generated
' Returns "False" (0) if an error occurs
'
' Technique:
' This routine attempts to allocate the required Products.
' Uses "zqryOrderProductSelect" to find Products where Status not
' On Order, Allocated, or Invoiced. If Product is being returned
(negative
' quantity), posts to Inventory or the original PO as appropriate.
' If Product is being ordered (positive quantity), allocates from stock
' in inventory. At end of allocation if some still not allocated from
' inventory, then stuffs the unordered Products in ztTblProductsToOrder
' and calls the common PO build routine.
'
' Note: When called from zfrmLoadData, intSilent is True - procedure will
' open no forms and will not display any errors. zfrmLoadData also
' passes the date it wants to use as the allocation / PODate date.
'
Dim db As DAO.Database, qd As DAO.QueryDef, qdA As DAO.QueryDef
Dim rsA As DAO.Recordset, rsI As DAO.Recordset, rsS As DAO.Recordset
Dim rst As DAO.Recordset, rsP As DAO.Recordset, rsC As DAO.Recordset
Dim varQuantity As Variant, intQuantityReq As Integer
Dim varRet As Variant, intEditA As Integer, intRecCount As Integer
Dim intI As Integer, intSomeError As Integer, intSomeLeft As Integer
Dim intCount As Integer, intQty As Integer, intMult As Integer
Dim intL As Integer, curMinPrice As Currency, curCost As Currency
Dim curPrice As Currency, varCost As Variant, varPrice As Variant
Dim lngPO As Long, lngVendor As Long, intTrans As Integer
Dim lngProductID As Long, lngThisLine As Long, intAddedSome As Integer
Dim intDoPO As Integer, datAllocDate As Date, lngVend As Long
Dim rstW As DAO.Recordset, strSQL As String, strMsg As String

On Error Resume Next
' Set up for default false return
AllocateProducts = 0

' Set up the allocation date
datAllocDate = Date
' If passed a date variable
If Not IsMissing(varDate) Then
' .. and it's a valid date
If IsDate(varDate) Then
' Use the parameter value
datAllocDate = varDate
End If
End If

' Point to this database
Set db = DBEngine(0)(0)
' Open the Order and lock it!
Set rstW = db.OpenRecordset("Select OrderID From tblOrders " & _
"Where OrderID = " & lngOrder)
If rstW.EOF Then
If Not intSilent Then
MsgBox "Unexpected error: Can't find Order #" & _
lngOrder, vbCritical, gstrAppTitle
End If
Exit Function
End If
' Lock the order by editing it
rstW.Edit
If Err <> 0 Then
strMsg = "Error trying to edit Order #" & lngOrder
strMsg = strMsg & ". Someone else may be editing this Order."
If Not intSilent Then MsgBox strMsg, vbExclamation, gstrAppTitle
Exit Function
End If

' Set an error trap
On Error GoTo AllocOrderProducts_ERR

' Clean out working table to store Products not in stock
db.Execute "Delete * FROM zttblProductsToOrder;", dbFailOnError

' Turn on the hourglass and start a transaction
DoCmd.Hourglass True
BeginTrans
intTrans = True

' Open a recordset on Products to allocate
Set qdA = db.QueryDefs("zqryOrderProductSelect")
qdA![OrderParm] = lngOrder
Set rsA = qdA.OpenRecordset()
' Open the inventory table
Set rsI = db.OpenRecordset("tblInventory")

' Get count of Products to allocate rows for SysCmd
rsA.MoveLast
intRecCount = rsA.RecordCount
rsA.MoveFirst

' Show a progress meter
varRet = SysCmd(acSysCmdInitMeter, "Updating Inventory...",
intRecCount)

' Loop through all Products to allocate, deduct from stock,
' and adjust master Inventory row
Do Until rsA.EOF
' If returning products, ...
If rsA![AmtNeeded] < 0 Then
' See if return is to a Purchase Order
If IsNothing(rsA!OrderPONo) Then
' If no PO to credit, then return to inventory
intQty = rsA![AmtNeeded]
' Find the inventory record
rsI.FindFirst "ProductID = " & rsA!ProductID
If rsI.NoMatch Then
' Ooops -- can't find the inventory record to return
' the Product!
intSomeError = True
strMsg = "Error attempting to return Product # "
strMsg = strMsg & rsA!ProductID & " to inventory."
strMsg = strMsg & " Inventory record not found."
strMsg = strMsg & " The Order record has been
deleted."
If Not intSilent Then MsgBox strMsg, _
vbCritical, gstrAppTitle
' Delete the Order row
rsA.Delete
Else
' Found the Inventory row - edit it to lock it
rsI.Edit
' Find the matching Stock row for an inventory return
strSQL = "Select * From tblStock Where ([ProductID] =
"
strSQL = strSQL & rsA!ProductID
strSQL = strSQL & ") And ([Cost] = " & rsA!Cost & ")"
' If there's a VendorID, then also filter for vendor
If Not IsNothing(rsA!VendorID) Then
strSQL = strSQL & " AND ([VendorID] = " & _
rsA!VendorID & ")"
lngVendor = rsA!VendorID
End If
' Open the Stock recordset
Set rsS = db.OpenRecordset(strSQL)
If rsS.EOF Then
' Ooops -- can't find the stock row to return
' the Product!
intSomeError = True
strMsg = "Error attempting to return Product # "
strMsg = strMsg & rsA!ProductID & " to stock."
strMsg = strMsg & " Stock record that matches the
"
strMsg = strMsg & "vendor and cost not found."
strMsg = strMsg & " The Order record has been
deleted."
If Not intSilent Then MsgBox strMsg, _
vbCritical, gstrAppTitle
' Delete the Order row
rsA.Delete
Else
' Return the Products to the Stock record
rsS.Edit
' Subtract from Allocated amount -
' product now available back in stock
' NOTE: QuantityAllocated can be negative if
' previously allocated product was already
' invoiced. Will correct when invoiced item
credited.
rsS!QuantityAllocated = rsS!QuantityAllocated + _
rsA!AmtNeeded
rsS!QuantityRemaining = rsS!Quantity - _
(rsS!QuantityAllocated + rsS!QuantitySold + _
rsS!QuantityReturned)
lngVendor = rsS!VendorID
rsS.Update
intQuantityReq = 0
End If
rsS.Close
' Refresh the master inventory totals...
rsI.Edit
' Using a query here so that this routine will
' see the updated quantities within the transaction.
Set qd = db.QueryDefs("zqrySumStockParm")
qd!ItemToFind = rsA!ProductID
Set rst = qd.OpenRecordset()
' Update the calc values in the Inventory row.
If Not rst.EOF Then
rsI!HighCost = rst!MaxCost
rsI!QuantityInStock = rst!Available
rsI!QuantityOnHand = rst!Remain
Else
rsI!QuantityInStock = 0
rsI!QuantityOnHand = 0
End If
rst.Close
Set rst = Nothing
qd.Close
Set qd = Nothing
rsI.Update

' Update the Order status
rsA.Edit
rsA!Status = OrderStatus.Allocated
rsA!DateAlloc = datAllocDate
rsA!VendorID = lngVendor
rsA.Update
End If
Else
' There's a PO Number, so credit back to the PO!
' Open a recordset on PO Products to insert the row
Set rsP = db.OpenRecordset("zqryPOProductsForAlloc", _
dbOpenDynaset, dbAppendOnly)
' Insert a new PO Product row to queue up the credit
' Get "next" line no --
' must use recordset inside a transaction!
Set rsC = db.OpenRecordset("Select Max([LineNo]) As
[LastLineNo] " & _
"From tblPOProducts " & _
"Where [PONumber] = " & rsA!OrderPONo)
If IsNull(rsC!LastLineNo) Then
intL = 1
Else
intL = rsC!LastLineNo + 1
End If
rsC.Close
rsP.AddNew
rsP!PONumber = rsA!OrderPONo
' Setting the PO Number should "autolookup"
' the Vendor ID from the PO
If IsNothing(rsP!POVend) Then
' Ooops - means the PO does not exist!
If Not intSilent Then
MsgBox "Error attempting to credit product # " & _
rsA!ProductID & " to purchase order # " &
rsA!OrderPONo & _
". The Purchase Order cannot be found. " & _
"The PO Number in the Order has been zeroed.", _
vbCritical, gstrAppTitle
End If
intSomeError = True
rsA.Edit
' Zero out the PO Number
rsA!OrderPONumber = 0
rsA.Update
' Discard the POProduct row
rsP.Close
Set rsP = Nothing
Else
' OK - have a good PO, so set the rest of the fields
rsP!LineNo = intL
' copy Vendor ID from the Purchase Order
rsP!VendorID = rsP!POVend
lngVendor = rsP!POVend
' Copy the Product ID
rsP!ProductID = rsA!ProductID
' Save the quantity required
intQty = rsA![AmtNeeded]
' .. and the order multiple
' (number of sell units in one purchase unit)
intMult = rsA![OrderMultiple]
' Set the return quantity
rsP!SellQuantity = intQty
' If the quantity is an even multiple
If intQty Mod intMult = 0 Then
' Do an integer divide to get the amount to order
rsP!BuyQuantity = intQty \ intMult
Else
' else round up to the next buy amount
rsP!BuyQuantity = (intQty \ intMult) + 1
End If
' Set the order by ("case", "pallet")
rsP!OrderBy = rsA![OrderBy]
' Set the sell by ("each", "case")
rsP!SellBy = rsA![SellBy]
' Set the order multiple
rsP!OrderMultiple = intMult
' Use the vendor cost
rsP!Cost = rsP!VendCost
' Use price from the order
rsP!Price = rsA!Price
' Save the new PO Product row
rsP.Update
rsP.Close
Set rsP = Nothing
' Update the Order status
rsA.Edit
' Put the vendor we found in the order
rsA!VendorID = lngVendor
' Set the related PO line number
rsA!OrderPOLineNo = intL
' Mark the status "on order"
rsA!Status = OrderStatus.OnOrder
rsA.Update
' Finally, get the PO and unset its Completed flag
db.Execute ("Update tblPurchaseOrders " & _
"Set [Completed] = False " & _
"Where [PONumber] = " & rsA!OrderPONo)
End If
End If
' End of code to process returns
Else
' Start of code to process positive allocations
' Quantity is positive -- go try to allocate from inventory
intQuantityReq = rsA!AmtNeeded
' Find the Product in the master inventory table
rsI.FindFirst "ProductID = " & rsA!ProductID
If Not rsI.NoMatch Then
' We found the inventory row -- check for quantity
available
If rsI!QuantityOnHand > 0 Then
' Looks like some in stock,
' so open a recordset on the stock rows
strSQL = "Select * From tblStock"
strSQL = strSQL & " Where [ProductID] = " &
rsA!ProductID
strSQL = strSQL & " AND QuantityRemaining > 0"
strSQL = strSQL & " ORDER BY [DateReceived]"
' Recordset plucks off the oldest rows first
Set rsS = db.OpenRecordset(strSQL)
If Not rsS.EOF Then
rsS.Edit
' If this stock record has enough, then ...
If intQuantityReq <= rsS!QuantityRemaining Then
' .. pluck the Products from this stock row
and
we're done
' Add the quantity needed to Stock Allocated
rsS!QuantityAllocated = rsS!QuantityAllocated
+
_
intQuantityReq
' Reduce quantity remaining by quantity needed
rsS!QuantityRemaining =
rsS!QuantityRemaining -
_
intQuantityReq
' Save the record
rsS.Update
' Got it all - set required to zero
intQuantityReq = 0
Else
' .. otherwise, grab what's available
' Take whatever is remaining and add it to
allocated
rsS!QuantityAllocated = rsS!QuantityAllocated
+
_
rsS!QuantityRemaining
' Reduce required by amount that was remaining
intQuantityReq = intQuantityReq - _
rsS!QuantityRemaining
' Set remaining to zero
rsS!QuantityRemaining = 0
' Save the record
rsS.Update
End If
' Save the cost for updating the Order row
curCost = rsS!Cost
' Save the vendor ID for updating the Order row
lngVendor = rsS!VendorID
rsS.Close
' We're going to update the Order, so edit the row
rsA.Edit
' Update the Order with what we found in stock...
' If quantity remaining, then this will
' reduce the original quantity
rsA!AmtNeeded = (rsA!AmtNeeded - intQuantityReq)
' Set in the allocated found cost
rsA!Cost = curCost
' Set this amount allocated
rsA!Status = OrderStatus.Allocated
' Set the allocation date
rsA!DateAlloc = datAllocDate
' Update the Vendor ID
rsA!VendorID = lngVendor
' Save the Order record
rsA.Update
' Refresh the master inventory totals...
rsI.Edit
' Using a query here so that this routine '
' will see the updated quantities
' within the transaction.
Set qd = db.QueryDefs("zqrySumStockParm")
qd!ItemToFind = rsA!ProductID
Set rst = qd.OpenRecordset()
' Update the "unnormalized" calc values
' in the Inventory row.
If Not rst.EOF Then
rsI!HighCost = rst!MaxCost
rsI!QuantityInStock = rst!Available
rsI!QuantityOnHand = rst!Remain
Else
rsI!QuantityInStock = 0
rsI!QuantityOnHand = 0
End If
rst.Close
qd.Close
' Update the inventory master
rsI.Update
End If
End If
End If
' See if any remaining to allocate
If intQuantityReq > 0 Then
' Did we allocate any on the current row?
If rsA!Status = OrderStatus.Allocated Then
' Yes - need to create a new row
' with remaining quantity!
' Save the line number to get back
lngThisLine = rsA!LineNo
' Save values for new row
lngProductID = rsA!ProductID
curCost = rsA!Cost
curPrice = rsA!Price
' Now, add a new Order row!
' This is a cool trick in DAO - the new row will come
up
for
' processing at the end of the current recordset, so
we'll
' keep looking for available Stock records at other
costs until
' we either allocate all requested or end up with a
left over
' amount to stuff in a Purchase Order.
rsA.AddNew
intAddedSome = True
' Set the order ID
rsA!OrderID = lngOrder
' Use a query to find the current largest line number
Set rst = db.OpenRecordset("Select Max([LineNo]) As
MaxLine " & _
"From tblOrderProducts Where [OrderID] = " &
lngOrder)
rsA!LineNo = rst![MaxLine] + 1
rst.Close
' Set up Product ID, quantity, and prices
rsA!ProductID = lngProductID
rsA!Cost = curCost
rsA!Price = curPrice
rsA!AmtNeeded = intQuantityReq
rsA!Status = OrderStatus.None
' Save the new Order Products row with
' remaining unallocated amount
rsA.Update
' Reposition on the original line number to '
' continue processing!
rsA.FindFirst "[LineNo] = " & lngThisLine
If rsA.NoMatch Then ' Should not occur!
Error 3999
End If
End If
End If
End If
' Finished processing the current Order record - get the next
rsA.MoveNext
intI = intI + 1
' Update the status meter
varRet = SysCmd(acSysCmdUpdateMeter, intI)
Loop
' Done with all Order rows - clear the status bar
varRet = SysCmd(acSysCmdClearStatus)
' Commit what we've done
CommitTrans
intTrans = False
' Close off recordsets
rsA.Close
Set rsA = Nothing
rsI.Close
Set rsI = Nothing
rstW.Close
Set rstW = Nothing
' Turn off the hourglass
DoCmd.Hourglass False
' If got no warnings, then set up to return success
If Not (intSomeError) Then AllocateProducts = True
' If we added some Order rows
If (intAddedSome = True) Then
' If Order form loaded (it should be, but just checking)
If IsFormLoaded("frmOrders") Then
' Requery the subform
Forms!frmOrders!fsubOrderProducts.Requery
End If
End If
' See if any left unallocated - run the "append leftovers" query
Set qd = db.QueryDefs("zqappOrderProductsToOrder")
qd![OrderParm] = lngOrder
qd.Execute
' See if there are any rows
If DCount("*", "ztTblProductsToOrder") <> 0 Then
' Yes - set a flag
intSomeLeft = True
' Ask if user wants to create Purchase Orders
' But auto-create PO if called from zfrmLoadData
If intSilent Then
intDoPO = vbYes
Else
intDoPO = MsgBox("Insufficient stock in inventory for one " &
_
"or more Products required for this order. " & _
"Do you want to generate purchase orders for this order?",
_
vbQuestion + vbYesNo, gstrAppTitle)
End If
If intDoPO = vbYes Then
' Turn off local error trapping
On Error GoTo 0
' Call the Product PO generator - pass the silent flag
If GenProductsPO(lngOrder, intSilent, datAllocDate) Then
' Indicate Purchase Orders created
AllocateProducts = 1
intSomeLeft = False
End If
End If
End If
If (intSomeLeft = True) Then
If Not intSilent Then MsgBox "Some Products were not allocated, "
&
_
"but you cancelled PO creation.", vbInformation, gstrAppTitle
End If

' Let the DBEngine catch up with all this work
DBEngine.Idle dbFreeLocks

' Done
Exit Function

AllocOrderProducts_ERR:
' Display and log any errors
If Not intSilent Then MsgBox "Unexpected Error: " & Err & _
", " & Error, vbCritical, gstrAppTitle
ErrorLog "AllocateProducts", Err, Error
On Error Resume Next
' If a transaction was started, roll it back
If (intTrans = True) Then Rollback
' Clear the status bar
varRet = SysCmd(acSysCmdClearStatus)
' Turn off the hourglass
DoCmd.Hourglass False
' Bail!
Exit Function

End Function

End Sub

"Allen Browne" <Al*********@SeeSig.Invalid> wrote in message
news:44***********************@per-qv1-newsreader-01.iinet.net.au...
We need to know a bit more about the procedure that fails.

It it includes this line:
Set rs = db.OpenRecordset("SomeTable")
try:
Set rs = db.OpenRecordset("SomeTable", dbOpenDynaset)

If that does not work, post the line that fails, and any line like the
one above.

OpenRecordset defaults to a Dynaset type for attached tables, but to a
Table type for local tables. If that is the issue, then declaring the
Dynaset type should solve the "operation is not supported for this type
of object" error.

"royaltiger" <sg*****@ntlworld.com> wrote in message
news:yt*******************@newsfe2-win.ntli.net...
I am trying to copy the inventory database in Building Access
Applications by John L Viescas but when i try to run the database i get
an error in the orders form when i click on the allocate button
"Unexpected Error":3251 operation is not supported for this type of
object.The demo cd has two databases, one is called inventory and the
other just has the tables for the design called inventory data. When you
run inventory the database works fine so i thought i would use the
tables in the "data" and then import the queries and forms from the
inventory, everything works fine until i want to allocate products to a
customer, i have compared tables in both databases and they are exact
except that the inventory is a linked database, this is what i think is
the problem and the table itself is the tblInventory. Is there a few
people out there who have the book and know what i am doing wrong or
know what to do to make it right



Feb 27 '06 #6

P: n/a
Open the code window.
Choose Compile from the Debug menu.
Does it compile okay?

--
Allen Browne - Microsoft MVP. Perth, Western Australia.
Tips for Access users - http://allenbrowne.com/tips.html
Reply to group, rather than allenbrowne at mvps dot org.

"royaltiger" <sg*****@ntlworld.com> wrote in message
news:Od*****************@newsfe3-win.ntli.net...
This is where i am confused, when i click on the allocate button all i get
is Unexpected Error:3251 operation is not supported for this type of
object so i click ok then error trap code says an error occured while
attempting to AllocateProducts for this order, and again i click ok, if
you mean does it open into visual basic and halt on a line it does not, it
stays with the order form.I also dont understand what linked tables are
about only that i cant alter any properties in design mode which is what i
need to adjust to my liking which is where i think is a problem, if i
click on file, Get Externel Data and import just the one table called
tblInventory the program works but it is a linked table whilst all others
are normal.If i then copy the table and paste keeping structure database
stops woking again
"Allen Browne" <Al*********@SeeSig.Invalid> wrote in message
news:44***********************@per-qv1-newsreader-01.iinet.net.au...
And which line generates the error?

"royaltiger" <sg*****@ntlworld.com> wrote in message
news:_x*******************@newsfe7-win.ntli.net...
This is the AllocateProducts function placed in a module called
modInventory.
Option Compare Database 'Use database order for string comparisons
Option Explicit
Dim mlngLineNum As Long, mlngErr As Long, mstrError As String

Function AllocateProducts(lngOrder As Long, _
Optional intSilent As Integer = 0, _
Optional varDate As Variant) As Integer
'
' Inputs: Order ID
' Optional "run silent" indicator (used by zfrmLoadData)
' Optional process date (used by zfrmLoadData)
'
' Output: Returns "True" (-1) if all Products allocated successfully
' Returns +1 if Products allocated and purchase order(s)
generated
' Returns "False" (0) if an error occurs
'
' Technique:
' This routine attempts to allocate the required Products.
' Uses "zqryOrderProductSelect" to find Products where Status not
' On Order, Allocated, or Invoiced. If Product is being returned
(negative
' quantity), posts to Inventory or the original PO as appropriate.
' If Product is being ordered (positive quantity), allocates from
stock
' in inventory. At end of allocation if some still not allocated from
' inventory, then stuffs the unordered Products in
ztTblProductsToOrder
' and calls the common PO build routine.
'
' Note: When called from zfrmLoadData, intSilent is True - procedure
will
' open no forms and will not display any errors. zfrmLoadData
also
' passes the date it wants to use as the allocation / PODate date.
'
Dim db As DAO.Database, qd As DAO.QueryDef, qdA As DAO.QueryDef
Dim rsA As DAO.Recordset, rsI As DAO.Recordset, rsS As DAO.Recordset
Dim rst As DAO.Recordset, rsP As DAO.Recordset, rsC As DAO.Recordset
Dim varQuantity As Variant, intQuantityReq As Integer
Dim varRet As Variant, intEditA As Integer, intRecCount As Integer
Dim intI As Integer, intSomeError As Integer, intSomeLeft As Integer
Dim intCount As Integer, intQty As Integer, intMult As Integer
Dim intL As Integer, curMinPrice As Currency, curCost As Currency
Dim curPrice As Currency, varCost As Variant, varPrice As Variant
Dim lngPO As Long, lngVendor As Long, intTrans As Integer
Dim lngProductID As Long, lngThisLine As Long, intAddedSome As Integer
Dim intDoPO As Integer, datAllocDate As Date, lngVend As Long
Dim rstW As DAO.Recordset, strSQL As String, strMsg As String

On Error Resume Next
' Set up for default false return
AllocateProducts = 0

' Set up the allocation date
datAllocDate = Date
' If passed a date variable
If Not IsMissing(varDate) Then
' .. and it's a valid date
If IsDate(varDate) Then
' Use the parameter value
datAllocDate = varDate
End If
End If

' Point to this database
Set db = DBEngine(0)(0)
' Open the Order and lock it!
Set rstW = db.OpenRecordset("Select OrderID From tblOrders " & _
"Where OrderID = " & lngOrder)
If rstW.EOF Then
If Not intSilent Then
MsgBox "Unexpected error: Can't find Order #" & _
lngOrder, vbCritical, gstrAppTitle
End If
Exit Function
End If
' Lock the order by editing it
rstW.Edit
If Err <> 0 Then
strMsg = "Error trying to edit Order #" & lngOrder
strMsg = strMsg & ". Someone else may be editing this Order."
If Not intSilent Then MsgBox strMsg, vbExclamation, gstrAppTitle
Exit Function
End If

' Set an error trap
On Error GoTo AllocOrderProducts_ERR

' Clean out working table to store Products not in stock
db.Execute "Delete * FROM zttblProductsToOrder;", dbFailOnError

' Turn on the hourglass and start a transaction
DoCmd.Hourglass True
BeginTrans
intTrans = True

' Open a recordset on Products to allocate
Set qdA = db.QueryDefs("zqryOrderProductSelect")
qdA![OrderParm] = lngOrder
Set rsA = qdA.OpenRecordset()
' Open the inventory table
Set rsI = db.OpenRecordset("tblInventory")

' Get count of Products to allocate rows for SysCmd
rsA.MoveLast
intRecCount = rsA.RecordCount
rsA.MoveFirst

' Show a progress meter
varRet = SysCmd(acSysCmdInitMeter, "Updating Inventory...",
intRecCount)

' Loop through all Products to allocate, deduct from stock,
' and adjust master Inventory row
Do Until rsA.EOF
' If returning products, ...
If rsA![AmtNeeded] < 0 Then
' See if return is to a Purchase Order
If IsNothing(rsA!OrderPONo) Then
' If no PO to credit, then return to inventory
intQty = rsA![AmtNeeded]
' Find the inventory record
rsI.FindFirst "ProductID = " & rsA!ProductID
If rsI.NoMatch Then
' Ooops -- can't find the inventory record to return
' the Product!
intSomeError = True
strMsg = "Error attempting to return Product # "
strMsg = strMsg & rsA!ProductID & " to inventory."
strMsg = strMsg & " Inventory record not found."
strMsg = strMsg & " The Order record has been
deleted."
If Not intSilent Then MsgBox strMsg, _
vbCritical, gstrAppTitle
' Delete the Order row
rsA.Delete
Else
' Found the Inventory row - edit it to lock it
rsI.Edit
' Find the matching Stock row for an inventory return
strSQL = "Select * From tblStock Where ([ProductID] =
"
strSQL = strSQL & rsA!ProductID
strSQL = strSQL & ") And ([Cost] = " & rsA!Cost & ")"
' If there's a VendorID, then also filter for vendor
If Not IsNothing(rsA!VendorID) Then
strSQL = strSQL & " AND ([VendorID] = " & _
rsA!VendorID & ")"
lngVendor = rsA!VendorID
End If
' Open the Stock recordset
Set rsS = db.OpenRecordset(strSQL)
If rsS.EOF Then
' Ooops -- can't find the stock row to return
' the Product!
intSomeError = True
strMsg = "Error attempting to return Product # "
strMsg = strMsg & rsA!ProductID & " to stock."
strMsg = strMsg & " Stock record that matches
the "
strMsg = strMsg & "vendor and cost not found."
strMsg = strMsg & " The Order record has been
deleted."
If Not intSilent Then MsgBox strMsg, _
vbCritical, gstrAppTitle
' Delete the Order row
rsA.Delete
Else
' Return the Products to the Stock record
rsS.Edit
' Subtract from Allocated amount -
' product now available back in stock
' NOTE: QuantityAllocated can be negative if
' previously allocated product was already
' invoiced. Will correct when invoiced
item
credited.
rsS!QuantityAllocated = rsS!QuantityAllocated + _
rsA!AmtNeeded
rsS!QuantityRemaining = rsS!Quantity - _
(rsS!QuantityAllocated + rsS!QuantitySold + _
rsS!QuantityReturned)
lngVendor = rsS!VendorID
rsS.Update
intQuantityReq = 0
End If
rsS.Close
' Refresh the master inventory totals...
rsI.Edit
' Using a query here so that this routine will
' see the updated quantities within the transaction.
Set qd = db.QueryDefs("zqrySumStockParm")
qd!ItemToFind = rsA!ProductID
Set rst = qd.OpenRecordset()
' Update the calc values in the Inventory row.
If Not rst.EOF Then
rsI!HighCost = rst!MaxCost
rsI!QuantityInStock = rst!Available
rsI!QuantityOnHand = rst!Remain
Else
rsI!QuantityInStock = 0
rsI!QuantityOnHand = 0
End If
rst.Close
Set rst = Nothing
qd.Close
Set qd = Nothing
rsI.Update

' Update the Order status
rsA.Edit
rsA!Status = OrderStatus.Allocated
rsA!DateAlloc = datAllocDate
rsA!VendorID = lngVendor
rsA.Update
End If
Else
' There's a PO Number, so credit back to the PO!
' Open a recordset on PO Products to insert the row
Set rsP = db.OpenRecordset("zqryPOProductsForAlloc", _
dbOpenDynaset, dbAppendOnly)
' Insert a new PO Product row to queue up the credit
' Get "next" line no --
' must use recordset inside a transaction!
Set rsC = db.OpenRecordset("Select Max([LineNo]) As
[LastLineNo] " & _
"From tblPOProducts " & _
"Where [PONumber] = " & rsA!OrderPONo)
If IsNull(rsC!LastLineNo) Then
intL = 1
Else
intL = rsC!LastLineNo + 1
End If
rsC.Close
rsP.AddNew
rsP!PONumber = rsA!OrderPONo
' Setting the PO Number should "autolookup"
' the Vendor ID from the PO
If IsNothing(rsP!POVend) Then
' Ooops - means the PO does not exist!
If Not intSilent Then
MsgBox "Error attempting to credit product # " &
_
rsA!ProductID & " to purchase order # " &
rsA!OrderPONo & _
". The Purchase Order cannot be found. " & _
"The PO Number in the Order has been zeroed.", _
vbCritical, gstrAppTitle
End If
intSomeError = True
rsA.Edit
' Zero out the PO Number
rsA!OrderPONumber = 0
rsA.Update
' Discard the POProduct row
rsP.Close
Set rsP = Nothing
Else
' OK - have a good PO, so set the rest of the fields
rsP!LineNo = intL
' copy Vendor ID from the Purchase Order
rsP!VendorID = rsP!POVend
lngVendor = rsP!POVend
' Copy the Product ID
rsP!ProductID = rsA!ProductID
' Save the quantity required
intQty = rsA![AmtNeeded]
' .. and the order multiple
' (number of sell units in one purchase unit)
intMult = rsA![OrderMultiple]
' Set the return quantity
rsP!SellQuantity = intQty
' If the quantity is an even multiple
If intQty Mod intMult = 0 Then
' Do an integer divide to get the amount to order
rsP!BuyQuantity = intQty \ intMult
Else
' else round up to the next buy amount
rsP!BuyQuantity = (intQty \ intMult) + 1
End If
' Set the order by ("case", "pallet")
rsP!OrderBy = rsA![OrderBy]
' Set the sell by ("each", "case")
rsP!SellBy = rsA![SellBy]
' Set the order multiple
rsP!OrderMultiple = intMult
' Use the vendor cost
rsP!Cost = rsP!VendCost
' Use price from the order
rsP!Price = rsA!Price
' Save the new PO Product row
rsP.Update
rsP.Close
Set rsP = Nothing
' Update the Order status
rsA.Edit
' Put the vendor we found in the order
rsA!VendorID = lngVendor
' Set the related PO line number
rsA!OrderPOLineNo = intL
' Mark the status "on order"
rsA!Status = OrderStatus.OnOrder
rsA.Update
' Finally, get the PO and unset its Completed flag
db.Execute ("Update tblPurchaseOrders " & _
"Set [Completed] = False " & _
"Where [PONumber] = " & rsA!OrderPONo)
End If
End If
' End of code to process returns
Else
' Start of code to process positive allocations
' Quantity is positive -- go try to allocate from inventory
intQuantityReq = rsA!AmtNeeded
' Find the Product in the master inventory table
rsI.FindFirst "ProductID = " & rsA!ProductID
If Not rsI.NoMatch Then
' We found the inventory row -- check for quantity
available
If rsI!QuantityOnHand > 0 Then
' Looks like some in stock,
' so open a recordset on the stock rows
strSQL = "Select * From tblStock"
strSQL = strSQL & " Where [ProductID] = " &
rsA!ProductID
strSQL = strSQL & " AND QuantityRemaining > 0"
strSQL = strSQL & " ORDER BY [DateReceived]"
' Recordset plucks off the oldest rows first
Set rsS = db.OpenRecordset(strSQL)
If Not rsS.EOF Then
rsS.Edit
' If this stock record has enough, then ...
If intQuantityReq <= rsS!QuantityRemaining Then
' .. pluck the Products from this stock row
and
we're done
' Add the quantity needed to Stock Allocated
rsS!QuantityAllocated = rsS!QuantityAllocated
+
_
intQuantityReq
' Reduce quantity remaining by quantity
needed
rsS!QuantityRemaining =
rsS!QuantityRemaining -
_
intQuantityReq
' Save the record
rsS.Update
' Got it all - set required to zero
intQuantityReq = 0
Else
' .. otherwise, grab what's available
' Take whatever is remaining and add it to
allocated
rsS!QuantityAllocated = rsS!QuantityAllocated
+
_
rsS!QuantityRemaining
' Reduce required by amount that was
remaining
intQuantityReq = intQuantityReq - _
rsS!QuantityRemaining
' Set remaining to zero
rsS!QuantityRemaining = 0
' Save the record
rsS.Update
End If
' Save the cost for updating the Order row
curCost = rsS!Cost
' Save the vendor ID for updating the Order row
lngVendor = rsS!VendorID
rsS.Close
' We're going to update the Order, so edit the
row
rsA.Edit
' Update the Order with what we found in stock...
' If quantity remaining, then this will
' reduce the original quantity
rsA!AmtNeeded = (rsA!AmtNeeded - intQuantityReq)
' Set in the allocated found cost
rsA!Cost = curCost
' Set this amount allocated
rsA!Status = OrderStatus.Allocated
' Set the allocation date
rsA!DateAlloc = datAllocDate
' Update the Vendor ID
rsA!VendorID = lngVendor
' Save the Order record
rsA.Update
' Refresh the master inventory totals...
rsI.Edit
' Using a query here so that this routine '
' will see the updated quantities
' within the transaction.
Set qd = db.QueryDefs("zqrySumStockParm")
qd!ItemToFind = rsA!ProductID
Set rst = qd.OpenRecordset()
' Update the "unnormalized" calc values
' in the Inventory row.
If Not rst.EOF Then
rsI!HighCost = rst!MaxCost
rsI!QuantityInStock = rst!Available
rsI!QuantityOnHand = rst!Remain
Else
rsI!QuantityInStock = 0
rsI!QuantityOnHand = 0
End If
rst.Close
qd.Close
' Update the inventory master
rsI.Update
End If
End If
End If
' See if any remaining to allocate
If intQuantityReq > 0 Then
' Did we allocate any on the current row?
If rsA!Status = OrderStatus.Allocated Then
' Yes - need to create a new row
' with remaining quantity!
' Save the line number to get back
lngThisLine = rsA!LineNo
' Save values for new row
lngProductID = rsA!ProductID
curCost = rsA!Cost
curPrice = rsA!Price
' Now, add a new Order row!
' This is a cool trick in DAO - the new row will come
up
for
' processing at the end of the current recordset, so
we'll
' keep looking for available Stock records at other
costs until
' we either allocate all requested or end up with a
left over
' amount to stuff in a Purchase Order.
rsA.AddNew
intAddedSome = True
' Set the order ID
rsA!OrderID = lngOrder
' Use a query to find the current largest line number
Set rst = db.OpenRecordset("Select Max([LineNo]) As
MaxLine " & _
"From tblOrderProducts Where [OrderID] = " &
lngOrder)
rsA!LineNo = rst![MaxLine] + 1
rst.Close
' Set up Product ID, quantity, and prices
rsA!ProductID = lngProductID
rsA!Cost = curCost
rsA!Price = curPrice
rsA!AmtNeeded = intQuantityReq
rsA!Status = OrderStatus.None
' Save the new Order Products row with
' remaining unallocated amount
rsA.Update
' Reposition on the original line number to '
' continue processing!
rsA.FindFirst "[LineNo] = " & lngThisLine
If rsA.NoMatch Then ' Should not occur!
Error 3999
End If
End If
End If
End If
' Finished processing the current Order record - get the next
rsA.MoveNext
intI = intI + 1
' Update the status meter
varRet = SysCmd(acSysCmdUpdateMeter, intI)
Loop
' Done with all Order rows - clear the status bar
varRet = SysCmd(acSysCmdClearStatus)
' Commit what we've done
CommitTrans
intTrans = False
' Close off recordsets
rsA.Close
Set rsA = Nothing
rsI.Close
Set rsI = Nothing
rstW.Close
Set rstW = Nothing
' Turn off the hourglass
DoCmd.Hourglass False
' If got no warnings, then set up to return success
If Not (intSomeError) Then AllocateProducts = True
' If we added some Order rows
If (intAddedSome = True) Then
' If Order form loaded (it should be, but just checking)
If IsFormLoaded("frmOrders") Then
' Requery the subform
Forms!frmOrders!fsubOrderProducts.Requery
End If
End If
' See if any left unallocated - run the "append leftovers" query
Set qd = db.QueryDefs("zqappOrderProductsToOrder")
qd![OrderParm] = lngOrder
qd.Execute
' See if there are any rows
If DCount("*", "ztTblProductsToOrder") <> 0 Then
' Yes - set a flag
intSomeLeft = True
' Ask if user wants to create Purchase Orders
' But auto-create PO if called from zfrmLoadData
If intSilent Then
intDoPO = vbYes
Else
intDoPO = MsgBox("Insufficient stock in inventory for one " &
_
"or more Products required for this order. " & _
"Do you want to generate purchase orders for this
order?", _
vbQuestion + vbYesNo, gstrAppTitle)
End If
If intDoPO = vbYes Then
' Turn off local error trapping
On Error GoTo 0
' Call the Product PO generator - pass the silent flag
If GenProductsPO(lngOrder, intSilent, datAllocDate) Then
' Indicate Purchase Orders created
AllocateProducts = 1
intSomeLeft = False
End If
End If
End If
If (intSomeLeft = True) Then
If Not intSilent Then MsgBox "Some Products were not allocated, "
&
_
"but you cancelled PO creation.", vbInformation, gstrAppTitle
End If

' Let the DBEngine catch up with all this work
DBEngine.Idle dbFreeLocks

' Done
Exit Function

AllocOrderProducts_ERR:
' Display and log any errors
If Not intSilent Then MsgBox "Unexpected Error: " & Err & _
", " & Error, vbCritical, gstrAppTitle
ErrorLog "AllocateProducts", Err, Error
On Error Resume Next
' If a transaction was started, roll it back
If (intTrans = True) Then Rollback
' Clear the status bar
varRet = SysCmd(acSysCmdClearStatus)
' Turn off the hourglass
DoCmd.Hourglass False
' Bail!
Exit Function

End Function

End Sub

"Allen Browne" <Al*********@SeeSig.Invalid> wrote in message
news:44***********************@per-qv1-newsreader-01.iinet.net.au...
We need to know a bit more about the procedure that fails.

It it includes this line:
Set rs = db.OpenRecordset("SomeTable")
try:
Set rs = db.OpenRecordset("SomeTable", dbOpenDynaset)

If that does not work, post the line that fails, and any line like the
one above.

OpenRecordset defaults to a Dynaset type for attached tables, but to a
Table type for local tables. If that is the issue, then declaring the
Dynaset type should solve the "operation is not supported for this type
of object" error.

"royaltiger" <sg*****@ntlworld.com> wrote in message
news:yt*******************@newsfe2-win.ntli.net...
>I am trying to copy the inventory database in Building Access
>Applications by John L Viescas but when i try to run the database i get
>an error in the orders form when i click on the allocate button
>"Unexpected Error":3251 operation is not supported for this type of
>object.The demo cd has two databases, one is called inventory and the
>other just has the tables for the design called inventory data. When
>you run inventory the database works fine so i thought i would use the
>tables in the "data" and then import the queries and forms from the
>inventory, everything works fine until i want to allocate products to a
>customer, i have compared tables in both databases and they are exact
>except that the inventory is a linked database, this is what i think is
>the problem and the table itself is the tblInventory. Is there a few
>people out there who have the book and know what i am doing wrong or
>know what to do to make it right



Feb 27 '06 #7

P: n/a
Works fine compiles straight away
"Allen Browne" <Al*********@SeeSig.Invalid> wrote in message
news:44***********************@per-qv1-newsreader-01.iinet.net.au...
Open the code window.
Choose Compile from the Debug menu.
Does it compile okay?

--
Allen Browne - Microsoft MVP. Perth, Western Australia.
Tips for Access users - http://allenbrowne.com/tips.html
Reply to group, rather than allenbrowne at mvps dot org.

"royaltiger" <sg*****@ntlworld.com> wrote in message
news:Od*****************@newsfe3-win.ntli.net...
This is where i am confused, when i click on the allocate button all i
get is Unexpected Error:3251 operation is not supported for this type of
object so i click ok then error trap code says an error occured while
attempting to AllocateProducts for this order, and again i click ok, if
you mean does it open into visual basic and halt on a line it does not,
it stays with the order form.I also dont understand what linked tables
are about only that i cant alter any properties in design mode which is
what i need to adjust to my liking which is where i think is a problem,
if i click on file, Get Externel Data and import just the one table
called tblInventory the program works but it is a linked table whilst all
others are normal.If i then copy the table and paste keeping structure
database stops woking again
"Allen Browne" <Al*********@SeeSig.Invalid> wrote in message
news:44***********************@per-qv1-newsreader-01.iinet.net.au...
And which line generates the error?

"royaltiger" <sg*****@ntlworld.com> wrote in message
news:_x*******************@newsfe7-win.ntli.net...
This is the AllocateProducts function placed in a module called
modInventory.
Option Compare Database 'Use database order for string comparisons
Option Explicit
Dim mlngLineNum As Long, mlngErr As Long, mstrError As String

Function AllocateProducts(lngOrder As Long, _
Optional intSilent As Integer = 0, _
Optional varDate As Variant) As Integer
'
' Inputs: Order ID
' Optional "run silent" indicator (used by zfrmLoadData)
' Optional process date (used by zfrmLoadData)
'
' Output: Returns "True" (-1) if all Products allocated successfully
' Returns +1 if Products allocated and purchase order(s)
generated
' Returns "False" (0) if an error occurs
'
' Technique:
' This routine attempts to allocate the required Products.
' Uses "zqryOrderProductSelect" to find Products where Status not
' On Order, Allocated, or Invoiced. If Product is being returned
(negative
' quantity), posts to Inventory or the original PO as appropriate.
' If Product is being ordered (positive quantity), allocates from
stock
' in inventory. At end of allocation if some still not allocated
from
' inventory, then stuffs the unordered Products in
ztTblProductsToOrder
' and calls the common PO build routine.
'
' Note: When called from zfrmLoadData, intSilent is True - procedure
will
' open no forms and will not display any errors. zfrmLoadData
also
' passes the date it wants to use as the allocation / PODate
date.
'
Dim db As DAO.Database, qd As DAO.QueryDef, qdA As DAO.QueryDef
Dim rsA As DAO.Recordset, rsI As DAO.Recordset, rsS As DAO.Recordset
Dim rst As DAO.Recordset, rsP As DAO.Recordset, rsC As DAO.Recordset
Dim varQuantity As Variant, intQuantityReq As Integer
Dim varRet As Variant, intEditA As Integer, intRecCount As Integer
Dim intI As Integer, intSomeError As Integer, intSomeLeft As Integer
Dim intCount As Integer, intQty As Integer, intMult As Integer
Dim intL As Integer, curMinPrice As Currency, curCost As Currency
Dim curPrice As Currency, varCost As Variant, varPrice As Variant
Dim lngPO As Long, lngVendor As Long, intTrans As Integer
Dim lngProductID As Long, lngThisLine As Long, intAddedSome As Integer
Dim intDoPO As Integer, datAllocDate As Date, lngVend As Long
Dim rstW As DAO.Recordset, strSQL As String, strMsg As String

On Error Resume Next
' Set up for default false return
AllocateProducts = 0

' Set up the allocation date
datAllocDate = Date
' If passed a date variable
If Not IsMissing(varDate) Then
' .. and it's a valid date
If IsDate(varDate) Then
' Use the parameter value
datAllocDate = varDate
End If
End If

' Point to this database
Set db = DBEngine(0)(0)
' Open the Order and lock it!
Set rstW = db.OpenRecordset("Select OrderID From tblOrders " & _
"Where OrderID = " & lngOrder)
If rstW.EOF Then
If Not intSilent Then
MsgBox "Unexpected error: Can't find Order #" & _
lngOrder, vbCritical, gstrAppTitle
End If
Exit Function
End If
' Lock the order by editing it
rstW.Edit
If Err <> 0 Then
strMsg = "Error trying to edit Order #" & lngOrder
strMsg = strMsg & ". Someone else may be editing this Order."
If Not intSilent Then MsgBox strMsg, vbExclamation, gstrAppTitle
Exit Function
End If

' Set an error trap
On Error GoTo AllocOrderProducts_ERR

' Clean out working table to store Products not in stock
db.Execute "Delete * FROM zttblProductsToOrder;", dbFailOnError

' Turn on the hourglass and start a transaction
DoCmd.Hourglass True
BeginTrans
intTrans = True

' Open a recordset on Products to allocate
Set qdA = db.QueryDefs("zqryOrderProductSelect")
qdA![OrderParm] = lngOrder
Set rsA = qdA.OpenRecordset()
' Open the inventory table
Set rsI = db.OpenRecordset("tblInventory")

' Get count of Products to allocate rows for SysCmd
rsA.MoveLast
intRecCount = rsA.RecordCount
rsA.MoveFirst

' Show a progress meter
varRet = SysCmd(acSysCmdInitMeter, "Updating Inventory...",
intRecCount)

' Loop through all Products to allocate, deduct from stock,
' and adjust master Inventory row
Do Until rsA.EOF
' If returning products, ...
If rsA![AmtNeeded] < 0 Then
' See if return is to a Purchase Order
If IsNothing(rsA!OrderPONo) Then
' If no PO to credit, then return to inventory
intQty = rsA![AmtNeeded]
' Find the inventory record
rsI.FindFirst "ProductID = " & rsA!ProductID
If rsI.NoMatch Then
' Ooops -- can't find the inventory record to return
' the Product!
intSomeError = True
strMsg = "Error attempting to return Product # "
strMsg = strMsg & rsA!ProductID & " to inventory."
strMsg = strMsg & " Inventory record not found."
strMsg = strMsg & " The Order record has been
deleted."
If Not intSilent Then MsgBox strMsg, _
vbCritical, gstrAppTitle
' Delete the Order row
rsA.Delete
Else
' Found the Inventory row - edit it to lock it
rsI.Edit
' Find the matching Stock row for an inventory
return
strSQL = "Select * From tblStock Where ([ProductID]
= "
strSQL = strSQL & rsA!ProductID
strSQL = strSQL & ") And ([Cost] = " & rsA!Cost &
")"
' If there's a VendorID, then also filter for vendor
If Not IsNothing(rsA!VendorID) Then
strSQL = strSQL & " AND ([VendorID] = " & _
rsA!VendorID & ")"
lngVendor = rsA!VendorID
End If
' Open the Stock recordset
Set rsS = db.OpenRecordset(strSQL)
If rsS.EOF Then
' Ooops -- can't find the stock row to return
' the Product!
intSomeError = True
strMsg = "Error attempting to return Product # "
strMsg = strMsg & rsA!ProductID & " to stock."
strMsg = strMsg & " Stock record that matches
the "
strMsg = strMsg & "vendor and cost not found."
strMsg = strMsg & " The Order record has been
deleted."
If Not intSilent Then MsgBox strMsg, _
vbCritical, gstrAppTitle
' Delete the Order row
rsA.Delete
Else
' Return the Products to the Stock record
rsS.Edit
' Subtract from Allocated amount -
' product now available back in stock
' NOTE: QuantityAllocated can be negative if
' previously allocated product was already
' invoiced. Will correct when invoiced
item
credited.
rsS!QuantityAllocated = rsS!QuantityAllocated +
_
rsA!AmtNeeded
rsS!QuantityRemaining = rsS!Quantity - _
(rsS!QuantityAllocated + rsS!QuantitySold +
_
rsS!QuantityReturned)
lngVendor = rsS!VendorID
rsS.Update
intQuantityReq = 0
End If
rsS.Close
' Refresh the master inventory totals...
rsI.Edit
' Using a query here so that this routine will
' see the updated quantities within the transaction.
Set qd = db.QueryDefs("zqrySumStockParm")
qd!ItemToFind = rsA!ProductID
Set rst = qd.OpenRecordset()
' Update the calc values in the Inventory row.
If Not rst.EOF Then
rsI!HighCost = rst!MaxCost
rsI!QuantityInStock = rst!Available
rsI!QuantityOnHand = rst!Remain
Else
rsI!QuantityInStock = 0
rsI!QuantityOnHand = 0
End If
rst.Close
Set rst = Nothing
qd.Close
Set qd = Nothing
rsI.Update

' Update the Order status
rsA.Edit
rsA!Status = OrderStatus.Allocated
rsA!DateAlloc = datAllocDate
rsA!VendorID = lngVendor
rsA.Update
End If
Else
' There's a PO Number, so credit back to the PO!
' Open a recordset on PO Products to insert the row
Set rsP = db.OpenRecordset("zqryPOProductsForAlloc", _
dbOpenDynaset, dbAppendOnly)
' Insert a new PO Product row to queue up the credit
' Get "next" line no --
' must use recordset inside a transaction!
Set rsC = db.OpenRecordset("Select Max([LineNo]) As
[LastLineNo] " & _
"From tblPOProducts " & _
"Where [PONumber] = " & rsA!OrderPONo)
If IsNull(rsC!LastLineNo) Then
intL = 1
Else
intL = rsC!LastLineNo + 1
End If
rsC.Close
rsP.AddNew
rsP!PONumber = rsA!OrderPONo
' Setting the PO Number should "autolookup"
' the Vendor ID from the PO
If IsNothing(rsP!POVend) Then
' Ooops - means the PO does not exist!
If Not intSilent Then
MsgBox "Error attempting to credit product # " &
_
rsA!ProductID & " to purchase order # " &
rsA!OrderPONo & _
". The Purchase Order cannot be found. " & _
"The PO Number in the Order has been zeroed.", _
vbCritical, gstrAppTitle
End If
intSomeError = True
rsA.Edit
' Zero out the PO Number
rsA!OrderPONumber = 0
rsA.Update
' Discard the POProduct row
rsP.Close
Set rsP = Nothing
Else
' OK - have a good PO, so set the rest of the fields
rsP!LineNo = intL
' copy Vendor ID from the Purchase Order
rsP!VendorID = rsP!POVend
lngVendor = rsP!POVend
' Copy the Product ID
rsP!ProductID = rsA!ProductID
' Save the quantity required
intQty = rsA![AmtNeeded]
' .. and the order multiple
' (number of sell units in one purchase unit)
intMult = rsA![OrderMultiple]
' Set the return quantity
rsP!SellQuantity = intQty
' If the quantity is an even multiple
If intQty Mod intMult = 0 Then
' Do an integer divide to get the amount to
order
rsP!BuyQuantity = intQty \ intMult
Else
' else round up to the next buy amount
rsP!BuyQuantity = (intQty \ intMult) + 1
End If
' Set the order by ("case", "pallet")
rsP!OrderBy = rsA![OrderBy]
' Set the sell by ("each", "case")
rsP!SellBy = rsA![SellBy]
' Set the order multiple
rsP!OrderMultiple = intMult
' Use the vendor cost
rsP!Cost = rsP!VendCost
' Use price from the order
rsP!Price = rsA!Price
' Save the new PO Product row
rsP.Update
rsP.Close
Set rsP = Nothing
' Update the Order status
rsA.Edit
' Put the vendor we found in the order
rsA!VendorID = lngVendor
' Set the related PO line number
rsA!OrderPOLineNo = intL
' Mark the status "on order"
rsA!Status = OrderStatus.OnOrder
rsA.Update
' Finally, get the PO and unset its Completed flag
db.Execute ("Update tblPurchaseOrders " & _
"Set [Completed] = False " & _
"Where [PONumber] = " & rsA!OrderPONo)
End If
End If
' End of code to process returns
Else
' Start of code to process positive allocations
' Quantity is positive -- go try to allocate from inventory
intQuantityReq = rsA!AmtNeeded
' Find the Product in the master inventory table
rsI.FindFirst "ProductID = " & rsA!ProductID
If Not rsI.NoMatch Then
' We found the inventory row -- check for quantity
available
If rsI!QuantityOnHand > 0 Then
' Looks like some in stock,
' so open a recordset on the stock rows
strSQL = "Select * From tblStock"
strSQL = strSQL & " Where [ProductID] = " &
rsA!ProductID
strSQL = strSQL & " AND QuantityRemaining > 0"
strSQL = strSQL & " ORDER BY [DateReceived]"
' Recordset plucks off the oldest rows first
Set rsS = db.OpenRecordset(strSQL)
If Not rsS.EOF Then
rsS.Edit
' If this stock record has enough, then ...
If intQuantityReq <= rsS!QuantityRemaining Then
' .. pluck the Products from this stock row
and
we're done
' Add the quantity needed to Stock Allocated
rsS!QuantityAllocated =
rsS!QuantityAllocated +
_
intQuantityReq
' Reduce quantity remaining by quantity
needed
rsS!QuantityRemaining =
rsS!QuantityRemaining -
_
intQuantityReq
' Save the record
rsS.Update
' Got it all - set required to zero
intQuantityReq = 0
Else
' .. otherwise, grab what's available
' Take whatever is remaining and add it to
allocated
rsS!QuantityAllocated =
rsS!QuantityAllocated +
_
rsS!QuantityRemaining
' Reduce required by amount that was
remaining
intQuantityReq = intQuantityReq - _
rsS!QuantityRemaining
' Set remaining to zero
rsS!QuantityRemaining = 0
' Save the record
rsS.Update
End If
' Save the cost for updating the Order row
curCost = rsS!Cost
' Save the vendor ID for updating the Order row
lngVendor = rsS!VendorID
rsS.Close
' We're going to update the Order, so edit the
row
rsA.Edit
' Update the Order with what we found in
stock...
' If quantity remaining, then this will
' reduce the original quantity
rsA!AmtNeeded = (rsA!AmtNeeded - intQuantityReq)
' Set in the allocated found cost
rsA!Cost = curCost
' Set this amount allocated
rsA!Status = OrderStatus.Allocated
' Set the allocation date
rsA!DateAlloc = datAllocDate
' Update the Vendor ID
rsA!VendorID = lngVendor
' Save the Order record
rsA.Update
' Refresh the master inventory totals...
rsI.Edit
' Using a query here so that this routine '
' will see the updated quantities
' within the transaction.
Set qd = db.QueryDefs("zqrySumStockParm")
qd!ItemToFind = rsA!ProductID
Set rst = qd.OpenRecordset()
' Update the "unnormalized" calc values
' in the Inventory row.
If Not rst.EOF Then
rsI!HighCost = rst!MaxCost
rsI!QuantityInStock = rst!Available
rsI!QuantityOnHand = rst!Remain
Else
rsI!QuantityInStock = 0
rsI!QuantityOnHand = 0
End If
rst.Close
qd.Close
' Update the inventory master
rsI.Update
End If
End If
End If
' See if any remaining to allocate
If intQuantityReq > 0 Then
' Did we allocate any on the current row?
If rsA!Status = OrderStatus.Allocated Then
' Yes - need to create a new row
' with remaining quantity!
' Save the line number to get back
lngThisLine = rsA!LineNo
' Save values for new row
lngProductID = rsA!ProductID
curCost = rsA!Cost
curPrice = rsA!Price
' Now, add a new Order row!
' This is a cool trick in DAO - the new row will
come up
for
' processing at the end of the current recordset,
so
we'll
' keep looking for available Stock records at other
costs until
' we either allocate all requested or end up with a
left over
' amount to stuff in a Purchase Order.
rsA.AddNew
intAddedSome = True
' Set the order ID
rsA!OrderID = lngOrder
' Use a query to find the current largest line
number
Set rst = db.OpenRecordset("Select Max([LineNo]) As
MaxLine " & _
"From tblOrderProducts Where [OrderID] = " &
lngOrder)
rsA!LineNo = rst![MaxLine] + 1
rst.Close
' Set up Product ID, quantity, and prices
rsA!ProductID = lngProductID
rsA!Cost = curCost
rsA!Price = curPrice
rsA!AmtNeeded = intQuantityReq
rsA!Status = OrderStatus.None
' Save the new Order Products row with
' remaining unallocated amount
rsA.Update
' Reposition on the original line number to '
' continue processing!
rsA.FindFirst "[LineNo] = " & lngThisLine
If rsA.NoMatch Then ' Should not occur!
Error 3999
End If
End If
End If
End If
' Finished processing the current Order record - get the next
rsA.MoveNext
intI = intI + 1
' Update the status meter
varRet = SysCmd(acSysCmdUpdateMeter, intI)
Loop
' Done with all Order rows - clear the status bar
varRet = SysCmd(acSysCmdClearStatus)
' Commit what we've done
CommitTrans
intTrans = False
' Close off recordsets
rsA.Close
Set rsA = Nothing
rsI.Close
Set rsI = Nothing
rstW.Close
Set rstW = Nothing
' Turn off the hourglass
DoCmd.Hourglass False
' If got no warnings, then set up to return success
If Not (intSomeError) Then AllocateProducts = True
' If we added some Order rows
If (intAddedSome = True) Then
' If Order form loaded (it should be, but just checking)
If IsFormLoaded("frmOrders") Then
' Requery the subform
Forms!frmOrders!fsubOrderProducts.Requery
End If
End If
' See if any left unallocated - run the "append leftovers" query
Set qd = db.QueryDefs("zqappOrderProductsToOrder")
qd![OrderParm] = lngOrder
qd.Execute
' See if there are any rows
If DCount("*", "ztTblProductsToOrder") <> 0 Then
' Yes - set a flag
intSomeLeft = True
' Ask if user wants to create Purchase Orders
' But auto-create PO if called from zfrmLoadData
If intSilent Then
intDoPO = vbYes
Else
intDoPO = MsgBox("Insufficient stock in inventory for one "
& _
"or more Products required for this order. " & _
"Do you want to generate purchase orders for this
order?", _
vbQuestion + vbYesNo, gstrAppTitle)
End If
If intDoPO = vbYes Then
' Turn off local error trapping
On Error GoTo 0
' Call the Product PO generator - pass the silent flag
If GenProductsPO(lngOrder, intSilent, datAllocDate) Then
' Indicate Purchase Orders created
AllocateProducts = 1
intSomeLeft = False
End If
End If
End If
If (intSomeLeft = True) Then
If Not intSilent Then MsgBox "Some Products were not allocated,
" &
_
"but you cancelled PO creation.", vbInformation,
gstrAppTitle
End If

' Let the DBEngine catch up with all this work
DBEngine.Idle dbFreeLocks

' Done
Exit Function

AllocOrderProducts_ERR:
' Display and log any errors
If Not intSilent Then MsgBox "Unexpected Error: " & Err & _
", " & Error, vbCritical, gstrAppTitle
ErrorLog "AllocateProducts", Err, Error
On Error Resume Next
' If a transaction was started, roll it back
If (intTrans = True) Then Rollback
' Clear the status bar
varRet = SysCmd(acSysCmdClearStatus)
' Turn off the hourglass
DoCmd.Hourglass False
' Bail!
Exit Function

End Function

End Sub

"Allen Browne" <Al*********@SeeSig.Invalid> wrote in message
news:44***********************@per-qv1-newsreader-01.iinet.net.au...
> We need to know a bit more about the procedure that fails.
>
> It it includes this line:
> Set rs = db.OpenRecordset("SomeTable")
> try:
> Set rs = db.OpenRecordset("SomeTable", dbOpenDynaset)
>
> If that does not work, post the line that fails, and any line like the
> one above.
>
> OpenRecordset defaults to a Dynaset type for attached tables, but to a
> Table type for local tables. If that is the issue, then declaring the
> Dynaset type should solve the "operation is not supported for this
> type of object" error.
>
> "royaltiger" <sg*****@ntlworld.com> wrote in message
> news:yt*******************@newsfe2-win.ntli.net...
>>I am trying to copy the inventory database in Building Access
>>Applications by John L Viescas but when i try to run the database i
>>get an error in the orders form when i click on the allocate button
>>"Unexpected Error":3251 operation is not supported for this type of
>>object.The demo cd has two databases, one is called inventory and the
>>other just has the tables for the design called inventory data. When
>>you run inventory the database works fine so i thought i would use the
>>tables in the "data" and then import the queries and forms from the
>>inventory, everything works fine until i want to allocate products to
>>a customer, i have compared tables in both databases and they are
>>exact except that the inventory is a linked database, this is what i
>>think is the problem and the table itself is the tblInventory. Is
>>there a few people out there who have the book and know what i am
>>doing wrong or know what to do to make it right
>
>



Feb 27 '06 #8

P: n/a
Have found a link to the problem
http://support.microsoft.com/kb/207836/en-us
"royaltiger" <sg*****@ntlworld.com> wrote in message
news:1X******************@newsfe2-gui.ntli.net...
Works fine compiles straight away
"Allen Browne" <Al*********@SeeSig.Invalid> wrote in message
news:44***********************@per-qv1-newsreader-01.iinet.net.au...
Open the code window.
Choose Compile from the Debug menu.
Does it compile okay?

--
Allen Browne - Microsoft MVP. Perth, Western Australia.
Tips for Access users - http://allenbrowne.com/tips.html
Reply to group, rather than allenbrowne at mvps dot org.

"royaltiger" <sg*****@ntlworld.com> wrote in message
news:Od*****************@newsfe3-win.ntli.net...
This is where i am confused, when i click on the allocate button all i
get is Unexpected Error:3251 operation is not supported for this type of
object so i click ok then error trap code says an error occured while
attempting to AllocateProducts for this order, and again i click ok, if
you mean does it open into visual basic and halt on a line it does not,
it stays with the order form.I also dont understand what linked tables
are about only that i cant alter any properties in design mode which is
what i need to adjust to my liking which is where i think is a problem,
if i click on file, Get Externel Data and import just the one table
called tblInventory the program works but it is a linked table whilst
all others are normal.If i then copy the table and paste keeping
structure database stops woking again
"Allen Browne" <Al*********@SeeSig.Invalid> wrote in message
news:44***********************@per-qv1-newsreader-01.iinet.net.au...
And which line generates the error?

"royaltiger" <sg*****@ntlworld.com> wrote in message
news:_x*******************@newsfe7-win.ntli.net...
> This is the AllocateProducts function placed in a module called
> modInventory.
> Option Compare Database 'Use database order for string comparisons
> Option Explicit
> Dim mlngLineNum As Long, mlngErr As Long, mstrError As String
>
> Function AllocateProducts(lngOrder As Long, _
> Optional intSilent As Integer = 0, _
> Optional varDate As Variant) As Integer
> '
> ' Inputs: Order ID
> ' Optional "run silent" indicator (used by zfrmLoadData)
> ' Optional process date (used by zfrmLoadData)
> '
> ' Output: Returns "True" (-1) if all Products allocated successfully
> ' Returns +1 if Products allocated and purchase order(s)
> generated
> ' Returns "False" (0) if an error occurs
> '
> ' Technique:
> ' This routine attempts to allocate the required Products.
> ' Uses "zqryOrderProductSelect" to find Products where Status not
> ' On Order, Allocated, or Invoiced. If Product is being returned
> (negative
> ' quantity), posts to Inventory or the original PO as appropriate.
> ' If Product is being ordered (positive quantity), allocates from
> stock
> ' in inventory. At end of allocation if some still not allocated
> from
> ' inventory, then stuffs the unordered Products in
> ztTblProductsToOrder
> ' and calls the common PO build routine.
> '
> ' Note: When called from zfrmLoadData, intSilent is True - procedure
> will
> ' open no forms and will not display any errors. zfrmLoadData
> also
> ' passes the date it wants to use as the allocation / PODate
> date.
> '
> Dim db As DAO.Database, qd As DAO.QueryDef, qdA As DAO.QueryDef
> Dim rsA As DAO.Recordset, rsI As DAO.Recordset, rsS As DAO.Recordset
> Dim rst As DAO.Recordset, rsP As DAO.Recordset, rsC As DAO.Recordset
> Dim varQuantity As Variant, intQuantityReq As Integer
> Dim varRet As Variant, intEditA As Integer, intRecCount As Integer
> Dim intI As Integer, intSomeError As Integer, intSomeLeft As Integer
> Dim intCount As Integer, intQty As Integer, intMult As Integer
> Dim intL As Integer, curMinPrice As Currency, curCost As Currency
> Dim curPrice As Currency, varCost As Variant, varPrice As Variant
> Dim lngPO As Long, lngVendor As Long, intTrans As Integer
> Dim lngProductID As Long, lngThisLine As Long, intAddedSome As Integer
> Dim intDoPO As Integer, datAllocDate As Date, lngVend As Long
> Dim rstW As DAO.Recordset, strSQL As String, strMsg As String
>
> On Error Resume Next
> ' Set up for default false return
> AllocateProducts = 0
>
> ' Set up the allocation date
> datAllocDate = Date
> ' If passed a date variable
> If Not IsMissing(varDate) Then
> ' .. and it's a valid date
> If IsDate(varDate) Then
> ' Use the parameter value
> datAllocDate = varDate
> End If
> End If
>
> ' Point to this database
> Set db = DBEngine(0)(0)
> ' Open the Order and lock it!
> Set rstW = db.OpenRecordset("Select OrderID From tblOrders " & _
> "Where OrderID = " & lngOrder)
> If rstW.EOF Then
> If Not intSilent Then
> MsgBox "Unexpected error: Can't find Order #" & _
> lngOrder, vbCritical, gstrAppTitle
> End If
> Exit Function
> End If
> ' Lock the order by editing it
> rstW.Edit
> If Err <> 0 Then
> strMsg = "Error trying to edit Order #" & lngOrder
> strMsg = strMsg & ". Someone else may be editing this Order."
> If Not intSilent Then MsgBox strMsg, vbExclamation,
> gstrAppTitle
> Exit Function
> End If
>
> ' Set an error trap
> On Error GoTo AllocOrderProducts_ERR
>
> ' Clean out working table to store Products not in stock
> db.Execute "Delete * FROM zttblProductsToOrder;", dbFailOnError
>
> ' Turn on the hourglass and start a transaction
> DoCmd.Hourglass True
> BeginTrans
> intTrans = True
>
> ' Open a recordset on Products to allocate
> Set qdA = db.QueryDefs("zqryOrderProductSelect")
> qdA![OrderParm] = lngOrder
> Set rsA = qdA.OpenRecordset()
> ' Open the inventory table
> Set rsI = db.OpenRecordset("tblInventory")
>
> ' Get count of Products to allocate rows for SysCmd
> rsA.MoveLast
> intRecCount = rsA.RecordCount
> rsA.MoveFirst
>
> ' Show a progress meter
> varRet = SysCmd(acSysCmdInitMeter, "Updating Inventory...",
> intRecCount)
>
> ' Loop through all Products to allocate, deduct from stock,
> ' and adjust master Inventory row
> Do Until rsA.EOF
> ' If returning products, ...
> If rsA![AmtNeeded] < 0 Then
> ' See if return is to a Purchase Order
> If IsNothing(rsA!OrderPONo) Then
> ' If no PO to credit, then return to inventory
> intQty = rsA![AmtNeeded]
> ' Find the inventory record
> rsI.FindFirst "ProductID = " & rsA!ProductID
> If rsI.NoMatch Then
> ' Ooops -- can't find the inventory record to
> return
> ' the Product!
> intSomeError = True
> strMsg = "Error attempting to return Product # "
> strMsg = strMsg & rsA!ProductID & " to inventory."
> strMsg = strMsg & " Inventory record not found."
> strMsg = strMsg & " The Order record has been
> deleted."
> If Not intSilent Then MsgBox strMsg, _
> vbCritical, gstrAppTitle
> ' Delete the Order row
> rsA.Delete
> Else
> ' Found the Inventory row - edit it to lock it
> rsI.Edit
> ' Find the matching Stock row for an inventory
> return
> strSQL = "Select * From tblStock Where ([ProductID]
> = "
> strSQL = strSQL & rsA!ProductID
> strSQL = strSQL & ") And ([Cost] = " & rsA!Cost &
> ")"
> ' If there's a VendorID, then also filter for
> vendor
> If Not IsNothing(rsA!VendorID) Then
> strSQL = strSQL & " AND ([VendorID] = " & _
> rsA!VendorID & ")"
> lngVendor = rsA!VendorID
> End If
> ' Open the Stock recordset
> Set rsS = db.OpenRecordset(strSQL)
> If rsS.EOF Then
> ' Ooops -- can't find the stock row to return
> ' the Product!
> intSomeError = True
> strMsg = "Error attempting to return Product #
> "
> strMsg = strMsg & rsA!ProductID & " to stock."
> strMsg = strMsg & " Stock record that matches
> the "
> strMsg = strMsg & "vendor and cost not found."
> strMsg = strMsg & " The Order record has been
> deleted."
> If Not intSilent Then MsgBox strMsg, _
> vbCritical, gstrAppTitle
> ' Delete the Order row
> rsA.Delete
> Else
> ' Return the Products to the Stock record
> rsS.Edit
> ' Subtract from Allocated amount -
> ' product now available back in stock
> ' NOTE: QuantityAllocated can be negative if
> ' previously allocated product was
> already
> ' invoiced. Will correct when invoiced
> item
> credited.
> rsS!QuantityAllocated = rsS!QuantityAllocated +
> _
> rsA!AmtNeeded
> rsS!QuantityRemaining = rsS!Quantity - _
> (rsS!QuantityAllocated + rsS!QuantitySold +
> _
> rsS!QuantityReturned)
> lngVendor = rsS!VendorID
> rsS.Update
> intQuantityReq = 0
> End If
> rsS.Close
> ' Refresh the master inventory totals...
> rsI.Edit
> ' Using a query here so that this routine will
> ' see the updated quantities within the
> transaction.
> Set qd = db.QueryDefs("zqrySumStockParm")
> qd!ItemToFind = rsA!ProductID
> Set rst = qd.OpenRecordset()
> ' Update the calc values in the Inventory row.
> If Not rst.EOF Then
> rsI!HighCost = rst!MaxCost
> rsI!QuantityInStock = rst!Available
> rsI!QuantityOnHand = rst!Remain
> Else
> rsI!QuantityInStock = 0
> rsI!QuantityOnHand = 0
> End If
> rst.Close
> Set rst = Nothing
> qd.Close
> Set qd = Nothing
> rsI.Update
>
> ' Update the Order status
> rsA.Edit
> rsA!Status = OrderStatus.Allocated
> rsA!DateAlloc = datAllocDate
> rsA!VendorID = lngVendor
> rsA.Update
> End If
> Else
> ' There's a PO Number, so credit back to the PO!
> ' Open a recordset on PO Products to insert the row
> Set rsP = db.OpenRecordset("zqryPOProductsForAlloc", _
> dbOpenDynaset, dbAppendOnly)
> ' Insert a new PO Product row to queue up the credit
> ' Get "next" line no --
> ' must use recordset inside a transaction!
> Set rsC = db.OpenRecordset("Select Max([LineNo]) As
> [LastLineNo] " & _
> "From tblPOProducts " & _
> "Where [PONumber] = " & rsA!OrderPONo)
> If IsNull(rsC!LastLineNo) Then
> intL = 1
> Else
> intL = rsC!LastLineNo + 1
> End If
> rsC.Close
> rsP.AddNew
> rsP!PONumber = rsA!OrderPONo
> ' Setting the PO Number should "autolookup"
> ' the Vendor ID from the PO
> If IsNothing(rsP!POVend) Then
> ' Ooops - means the PO does not exist!
> If Not intSilent Then
> MsgBox "Error attempting to credit product # "
> & _
> rsA!ProductID & " to purchase order # " &
> rsA!OrderPONo & _
> ". The Purchase Order cannot be found. " & _
> "The PO Number in the Order has been zeroed.",
> _
> vbCritical, gstrAppTitle
> End If
> intSomeError = True
> rsA.Edit
> ' Zero out the PO Number
> rsA!OrderPONumber = 0
> rsA.Update
> ' Discard the POProduct row
> rsP.Close
> Set rsP = Nothing
> Else
> ' OK - have a good PO, so set the rest of the
> fields
> rsP!LineNo = intL
> ' copy Vendor ID from the Purchase Order
> rsP!VendorID = rsP!POVend
> lngVendor = rsP!POVend
> ' Copy the Product ID
> rsP!ProductID = rsA!ProductID
> ' Save the quantity required
> intQty = rsA![AmtNeeded]
> ' .. and the order multiple
> ' (number of sell units in one purchase unit)
> intMult = rsA![OrderMultiple]
> ' Set the return quantity
> rsP!SellQuantity = intQty
> ' If the quantity is an even multiple
> If intQty Mod intMult = 0 Then
> ' Do an integer divide to get the amount to
> order
> rsP!BuyQuantity = intQty \ intMult
> Else
> ' else round up to the next buy amount
> rsP!BuyQuantity = (intQty \ intMult) + 1
> End If
> ' Set the order by ("case", "pallet")
> rsP!OrderBy = rsA![OrderBy]
> ' Set the sell by ("each", "case")
> rsP!SellBy = rsA![SellBy]
> ' Set the order multiple
> rsP!OrderMultiple = intMult
> ' Use the vendor cost
> rsP!Cost = rsP!VendCost
> ' Use price from the order
> rsP!Price = rsA!Price
> ' Save the new PO Product row
> rsP.Update
> rsP.Close
> Set rsP = Nothing
> ' Update the Order status
> rsA.Edit
> ' Put the vendor we found in the order
> rsA!VendorID = lngVendor
> ' Set the related PO line number
> rsA!OrderPOLineNo = intL
> ' Mark the status "on order"
> rsA!Status = OrderStatus.OnOrder
> rsA.Update
> ' Finally, get the PO and unset its Completed flag
> db.Execute ("Update tblPurchaseOrders " & _
> "Set [Completed] = False " & _
> "Where [PONumber] = " & rsA!OrderPONo)
> End If
> End If
> ' End of code to process returns
> Else
> ' Start of code to process positive allocations
> ' Quantity is positive -- go try to allocate from inventory
> intQuantityReq = rsA!AmtNeeded
> ' Find the Product in the master inventory table
> rsI.FindFirst "ProductID = " & rsA!ProductID
> If Not rsI.NoMatch Then
> ' We found the inventory row -- check for quantity
> available
> If rsI!QuantityOnHand > 0 Then
> ' Looks like some in stock,
> ' so open a recordset on the stock rows
> strSQL = "Select * From tblStock"
> strSQL = strSQL & " Where [ProductID] = " &
> rsA!ProductID
> strSQL = strSQL & " AND QuantityRemaining > 0"
> strSQL = strSQL & " ORDER BY [DateReceived]"
> ' Recordset plucks off the oldest rows first
> Set rsS = db.OpenRecordset(strSQL)
> If Not rsS.EOF Then
> rsS.Edit
> ' If this stock record has enough, then ...
> If intQuantityReq <= rsS!QuantityRemaining Then
> ' .. pluck the Products from this stock row
> and
> we're done
> ' Add the quantity needed to Stock
> Allocated
> rsS!QuantityAllocated =
> rsS!QuantityAllocated +
> _
> intQuantityReq
> ' Reduce quantity remaining by quantity
> needed
> rsS!QuantityRemaining =
> rsS!QuantityRemaining -
> _
> intQuantityReq
> ' Save the record
> rsS.Update
> ' Got it all - set required to zero
> intQuantityReq = 0
> Else
> ' .. otherwise, grab what's available
> ' Take whatever is remaining and add it to
> allocated
> rsS!QuantityAllocated =
> rsS!QuantityAllocated +
> _
> rsS!QuantityRemaining
> ' Reduce required by amount that was
> remaining
> intQuantityReq = intQuantityReq - _
> rsS!QuantityRemaining
> ' Set remaining to zero
> rsS!QuantityRemaining = 0
> ' Save the record
> rsS.Update
> End If
> ' Save the cost for updating the Order row
> curCost = rsS!Cost
> ' Save the vendor ID for updating the Order row
> lngVendor = rsS!VendorID
> rsS.Close
> ' We're going to update the Order, so edit the
> row
> rsA.Edit
> ' Update the Order with what we found in
> stock...
> ' If quantity remaining, then this will
> ' reduce the original quantity
> rsA!AmtNeeded = (rsA!AmtNeeded -
> intQuantityReq)
> ' Set in the allocated found cost
> rsA!Cost = curCost
> ' Set this amount allocated
> rsA!Status = OrderStatus.Allocated
> ' Set the allocation date
> rsA!DateAlloc = datAllocDate
> ' Update the Vendor ID
> rsA!VendorID = lngVendor
> ' Save the Order record
> rsA.Update
> ' Refresh the master inventory totals...
> rsI.Edit
> ' Using a query here so that this routine '
> ' will see the updated quantities
> ' within the transaction.
> Set qd = db.QueryDefs("zqrySumStockParm")
> qd!ItemToFind = rsA!ProductID
> Set rst = qd.OpenRecordset()
> ' Update the "unnormalized" calc values
> ' in the Inventory row.
> If Not rst.EOF Then
> rsI!HighCost = rst!MaxCost
> rsI!QuantityInStock = rst!Available
> rsI!QuantityOnHand = rst!Remain
> Else
> rsI!QuantityInStock = 0
> rsI!QuantityOnHand = 0
> End If
> rst.Close
> qd.Close
> ' Update the inventory master
> rsI.Update
> End If
> End If
> End If
> ' See if any remaining to allocate
> If intQuantityReq > 0 Then
> ' Did we allocate any on the current row?
> If rsA!Status = OrderStatus.Allocated Then
> ' Yes - need to create a new row
> ' with remaining quantity!
> ' Save the line number to get back
> lngThisLine = rsA!LineNo
> ' Save values for new row
> lngProductID = rsA!ProductID
> curCost = rsA!Cost
> curPrice = rsA!Price
> ' Now, add a new Order row!
> ' This is a cool trick in DAO - the new row will
> come up
> for
> ' processing at the end of the current recordset,
> so
> we'll
> ' keep looking for available Stock records at
> other
> costs until
> ' we either allocate all requested or end up with
> a
> left over
> ' amount to stuff in a Purchase Order.
> rsA.AddNew
> intAddedSome = True
> ' Set the order ID
> rsA!OrderID = lngOrder
> ' Use a query to find the current largest line
> number
> Set rst = db.OpenRecordset("Select Max([LineNo]) As
> MaxLine " & _
> "From tblOrderProducts Where [OrderID] = " &
> lngOrder)
> rsA!LineNo = rst![MaxLine] + 1
> rst.Close
> ' Set up Product ID, quantity, and prices
> rsA!ProductID = lngProductID
> rsA!Cost = curCost
> rsA!Price = curPrice
> rsA!AmtNeeded = intQuantityReq
> rsA!Status = OrderStatus.None
> ' Save the new Order Products row with
> ' remaining unallocated amount
> rsA.Update
> ' Reposition on the original line number to '
> ' continue processing!
> rsA.FindFirst "[LineNo] = " & lngThisLine
> If rsA.NoMatch Then ' Should not occur!
> Error 3999
> End If
> End If
> End If
> End If
> ' Finished processing the current Order record - get the next
> rsA.MoveNext
> intI = intI + 1
> ' Update the status meter
> varRet = SysCmd(acSysCmdUpdateMeter, intI)
> Loop
> ' Done with all Order rows - clear the status bar
> varRet = SysCmd(acSysCmdClearStatus)
> ' Commit what we've done
> CommitTrans
> intTrans = False
> ' Close off recordsets
> rsA.Close
> Set rsA = Nothing
> rsI.Close
> Set rsI = Nothing
> rstW.Close
> Set rstW = Nothing
> ' Turn off the hourglass
> DoCmd.Hourglass False
> ' If got no warnings, then set up to return success
> If Not (intSomeError) Then AllocateProducts = True
> ' If we added some Order rows
> If (intAddedSome = True) Then
> ' If Order form loaded (it should be, but just checking)
> If IsFormLoaded("frmOrders") Then
> ' Requery the subform
> Forms!frmOrders!fsubOrderProducts.Requery
> End If
> End If
> ' See if any left unallocated - run the "append leftovers" query
> Set qd = db.QueryDefs("zqappOrderProductsToOrder")
> qd![OrderParm] = lngOrder
> qd.Execute
> ' See if there are any rows
> If DCount("*", "ztTblProductsToOrder") <> 0 Then
> ' Yes - set a flag
> intSomeLeft = True
> ' Ask if user wants to create Purchase Orders
> ' But auto-create PO if called from zfrmLoadData
> If intSilent Then
> intDoPO = vbYes
> Else
> intDoPO = MsgBox("Insufficient stock in inventory for one "
> & _
> "or more Products required for this order. " & _
> "Do you want to generate purchase orders for this
> order?", _
> vbQuestion + vbYesNo, gstrAppTitle)
> End If
> If intDoPO = vbYes Then
> ' Turn off local error trapping
> On Error GoTo 0
> ' Call the Product PO generator - pass the silent flag
> If GenProductsPO(lngOrder, intSilent, datAllocDate) Then
> ' Indicate Purchase Orders created
> AllocateProducts = 1
> intSomeLeft = False
> End If
> End If
> End If
> If (intSomeLeft = True) Then
> If Not intSilent Then MsgBox "Some Products were not allocated,
> " &
> _
> "but you cancelled PO creation.", vbInformation,
> gstrAppTitle
> End If
>
> ' Let the DBEngine catch up with all this work
> DBEngine.Idle dbFreeLocks
>
> ' Done
> Exit Function
>
> AllocOrderProducts_ERR:
> ' Display and log any errors
> If Not intSilent Then MsgBox "Unexpected Error: " & Err & _
> ", " & Error, vbCritical, gstrAppTitle
> ErrorLog "AllocateProducts", Err, Error
> On Error Resume Next
> ' If a transaction was started, roll it back
> If (intTrans = True) Then Rollback
> ' Clear the status bar
> varRet = SysCmd(acSysCmdClearStatus)
> ' Turn off the hourglass
> DoCmd.Hourglass False
> ' Bail!
> Exit Function
>
> End Function
>
> End Sub
>
> "Allen Browne" <Al*********@SeeSig.Invalid> wrote in message
> news:44***********************@per-qv1-newsreader-01.iinet.net.au...
>> We need to know a bit more about the procedure that fails.
>>
>> It it includes this line:
>> Set rs = db.OpenRecordset("SomeTable")
>> try:
>> Set rs = db.OpenRecordset("SomeTable", dbOpenDynaset)
>>
>> If that does not work, post the line that fails, and any line like
>> the one above.
>>
>> OpenRecordset defaults to a Dynaset type for attached tables, but to
>> a Table type for local tables. If that is the issue, then declaring
>> the Dynaset type should solve the "operation is not supported for
>> this type of object" error.
>>
>> "royaltiger" <sg*****@ntlworld.com> wrote in message
>> news:yt*******************@newsfe2-win.ntli.net...
>>>I am trying to copy the inventory database in Building Access
>>>Applications by John L Viescas but when i try to run the database i
>>>get an error in the orders form when i click on the allocate button
>>>"Unexpected Error":3251 operation is not supported for this type of
>>>object.The demo cd has two databases, one is called inventory and the
>>>other just has the tables for the design called inventory data. When
>>>you run inventory the database works fine so i thought i would use
>>>the tables in the "data" and then import the queries and forms from
>>>the inventory, everything works fine until i want to allocate
>>>products to a customer, i have compared tables in both databases and
>>>they are exact except that the inventory is a linked database, this
>>>is what i think is the problem and the table itself is the
>>>tblInventory. Is there a few people out there who have the book and
>>>know what i am doing wrong or know what to do to make it right
>>
>>
>
>



Feb 27 '06 #9

P: n/a
royaltiger wrote:
Works fine compiles straight away
"Allen Browne" <Al*********@SeeSig.Invalid> wrote in message


Allen, King Tig,

I wonder if this is a result of the application coming from a cd and
being tagged read only? Has KingTig tried looking at the windows
properties of the app and making sure the read only attribute is not
ticked? I arsed myself up years ago agonizing over something that
sounds familiar to this, ie, when I copied one of my appps from a
cd-rom. I believe attributes are set to read only by default in a lot
of cases here?

--
Tim http://www.ucs.mun.ca/~tmarshal/
^o<
/#) "Burp-beep, burp-beep, burp-beep?" - Quaker Jake
/^^ "Whatcha doin?" - Ditto "TIM-MAY!!" - Me
Feb 27 '06 #10

P: n/a
Make a backup copy of your DB.
In a throw-away copy
Comment out each line that begins with
"On Error"
Then run code in the same way that produces the error. When the Error
dialog appears, make a note of the Error Message and number abd press
"Debug". If all goes well, the code where the Error occurs will be
shown and the line where the error occurs will be highlighted in
yellow, or perhaps some other colour if you have changed your
preferences. Hover the key over all variables in that line. Make a note
of the values of each (they should appear in the little box that
appears when you hover) and especially of those that do not have any
value.
Close your application and Access. (Depending on the error you may have
to reboot).
Restore your Error Handler pointing lines.
Report back to us the Error message and number, the line where the
error occurred and the value or non-value of the variables in the line.

Feb 27 '06 #11

P: n/a
readonly is unchecked
"Tim Marshall" <TI****@PurplePandaChasers.Moertherium> wrote in message
news:dt**********@coranto.ucs.mun.ca...
royaltiger wrote:
Works fine compiles straight away
"Allen Browne" <Al*********@SeeSig.Invalid> wrote in message


Allen, King Tig,

I wonder if this is a result of the application coming from a cd and being
tagged read only? Has KingTig tried looking at the windows properties of
the app and making sure the read only attribute is not ticked? I arsed
myself up years ago agonizing over something that sounds familiar to this,
ie, when I copied one of my appps from a cd-rom. I believe attributes are
set to read only by default in a lot of cases here?

--
Tim http://www.ucs.mun.ca/~tmarshal/
^o<
/#) "Burp-beep, burp-beep, burp-beep?" - Quaker Jake
/^^ "Whatcha doin?" - Ditto "TIM-MAY!!" - Me

Feb 27 '06 #12

P: n/a
This still makes no sense to me why this works as a linked database but if
i copy i get this error
SYMPTOMS
When you run code that uses the OldValue property of a control on a form,
you may receive the following error message:
Run-time error '3251':
Operation is not supported for this type of object.

CAUSE
Your form is based on an AutoLookup query that is based on more than one
table, and there is a one-to-many relationship between two of the tables.

When you change the data in one field of a record, the Microsoft Jet
database engine saves the entire record, instead of saving only the field
that you modified. When you change the data in any field on the "many" side
of the relationship, the data in the foreign key field is also saved again.
The Microsoft Jet database engine must then requery the fields from the
"one" side of the relationship; this ensures that they contain the data
corresponding to the value that you just saved in the foreign key field.
Once the Microsoft Jet database engine has requeried the field, trying to
access the value of the OldValue property of a control bound to that field
results in a run-time error because, at this point, the OldValue property is
no longer valid.

RESOLUTION
Use the RecordsetClone property of the form to retrieve a control's previous
value. In the following example, the OnCurrent property of a form is set to
an event procedure that creates a recordset; the recordset is a copy of the
form's underlying record source. The procedure uses the Bookmark property of
the recordset to find the record that corresponds to the current record on
the form. 1. Start Microsoft Access and open the sample database
Northwind.mdb.
2. Create the following query and base it on the Categories table and
the Products table:
Query: qryAutoLookup
-------------------------------------------------------
Type: Select Query
Join: Categories.[CategoryID] <->; Products.[CategoryID]

Field: ProductID
Table: Products
Field: Product Name
Table: Products
Field: CategoryID
Table: Products
Field: CategoryName
Table: Categories

3. Save the query as qryAutoLookup and close it.
4. In the Database window, click the qryAutoLookup query to select it.
5. On the Insert menu, click AutoForm.
6. After the auto form is created, click Design View on the View menu.
7. On the View menu, click Code.
8. In the Declarations section of the module, type the following line:
Dim rs as Recordset

9. Set the OnCurrent property of the form to the following event
procedure:
Private Sub Form_Current()
Set rs = Me.RecordsetClone
rs.Bookmark = Me.Bookmark
End Sub

10. Add a command button to the form and set its properties as
follows:
Name: OldCategory
Caption: Old Category Name

11. Set the OnClick property of the command button to the following
event procedure:
Private Sub OldCategory_Click()
MsgBox rs![CategoryName]
End Sub

12. Save the form as frmAutoFix and switch the form to Form view.
13. Change the value in the Product Name box.
14. Click Old Category Name. Note that the message box displays the
value of the CategoryName field and that no run-time error message appears.
15. Change the value in the Product Name box, and then change the
value in the Category box.
16. Click Old Category Name. Note that the message box displays the
previous value of the CategoryName field.

Back to the top

MORE INFORMATION
Steps to Reproduce Behavior
1. Follow steps 1 through 5 in the "Resolution" section of this
article.
2. Add a command button to the form and set its properties as follows:
Name: OldCategoryName
Caption: Old Category Name

3 Set the OnClick property of the command button to the following event
procedure:
Private Sub OldCategory_Click()
MsgBox Me![CategoryName].OldValue
End Sub

4. Save the form as frmOldValue and switch the form to Form view.
5. Change the value in the Product Name box.
6. Click Old Category Name. Note that you receive the error message
mentioned in the "Symptoms" section.

Feb 27 '06 #13

P: n/a
Have fun!

Feb 27 '06 #14

This discussion thread is closed

Replies have been disabled for this discussion.