Jamie Collins wrote:
Below is the whole code
.... except for the RemoveQty proc. I *REFUSE* to write SQL using Jet's
UPDATE..JOIN syntax because it violates the Standards and Jet refuses
to execute the Standard syntax e.g.
UPDATE MyTable SET MyCol = (<subquery returning scalar>)
so we're at an impasse <g>!
Sub CreateDB_LIFO_FIFO()
Dim cat As Object
Set cat = CreateObject("ADOX.Catalog")
With cat
.Create _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\DropMe.mdb;"
With .ActiveConnection
.Execute _
"CREATE TABLE WidgetInventory (receipt_nbr INTEGER NOT NULL PRIMARY
KEY, purchase_date" & _
" DATETIME DEFAULT NOW() NOT NULL, qty_on_hand INTEGER NOT NULL,
CHECK (qty_on_hand" & _
" >= 0), unit_price DECIMAL (12,4) NOT NULL);"
.Execute _
"INSERT INTO WidgetInventory (receipt_nbr, purchase_date,
qty_on_hand, unit_price)" & _
" VALUES (1, '2005-08-01', 15, 10.00);"
.Execute _
"INSERT INTO WidgetInventory (receipt_nbr, purchase_date,
qty_on_hand, unit_price)" & _
" VALUES (2, '2005-08-02', 25, 12.00);"
.Execute _
"INSERT INTO WidgetInventory (receipt_nbr, purchase_date,
qty_on_hand, unit_price)" & _
" VALUES (3, '2005-08-03', 40, 13.00); "
.Execute _
"INSERT INTO WidgetInventory (receipt_nbr, purchase_date,
qty_on_hand, unit_price)" & _
" VALUES (4, '2005-08-04', 35, 12.00); "
.Execute _
"INSERT INTO WidgetInventory (receipt_nbr, purchase_date,
qty_on_hand, unit_price)" & _
" VALUES (5, '2005-08-05', 45, 10.00);"
.Execute _
"CREATE VIEW LIFO (stock_date, unit_price, tot_qty_on_hand,
tot_cost) AS SELECT W1.purchase_date," & _
" W1.unit_price, SUM(W2.qty_on_hand), SUM(W2.qty_on_hand *
W2.unit_price) FROM WidgetInventory" & _
" AS W1, WidgetInventory AS W2 WHERE W2.purchase_date <=
W1.purchase_date GROUP BY" & _
" W1.purchase_date, W1.unit_price;"
.Execute _
"CREATE PROCEDURE GetCostLIFO
order_qty INTEGER) AS SELECT
SUM(W3.v) AS cost FROM (SELECT" & _
" W1.unit_price * IIF(SUM(W2.qty_on_hand) <=
rder_qty,
W1.qty_on_hand,
rder_qty" & _
" - (SUM(W2.qty_on_hand) - W1.qty_on_hand)) AS v FROM
WidgetInventory AS W1, WidgetInventory" & _
" AS W2 WHERE W1.purchase_date <= W2.purchase_date GROUP BY
W1.purchase_date, W1.qty_on_hand," & _
" W1.unit_price HAVING (SUM(W2.qty_on_hand) - W1.qty_on_hand) <=
rder_qty) AS W3;"
.Execute _
"CREATE VIEW FIFO (stock_date, unit_price, tot_qty_on_hand,
tot_cost) AS SELECT W1.purchase_date," & _
" W1.unit_price, SUM(W2.qty_on_hand), SUM(W2.qty_on_hand *
W2.unit_price) FROM WidgetInventory" & _
" AS W1, WidgetInventory AS W2 WHERE W2.purchase_date <=
W1.purchase_date GROUP BY" & _
" W1.purchase_date, W1.unit_price;"
.Execute _
"CREATE PROCEDURE GetCostFIFO
order_qty INTEGER) AS SELECT
(tot_cost - ((tot_qty_on_hand" & _
" -
rder_qty) * unit_price)) AS cost FROM FIFO AS F1 WHERE
stock_date = (SELECT" & _
" MIN (stock_date) FROM FIFO AS F2 WHERE tot_qty_on_hand >=
rder_qty);"
Dim rs1 As Object
Set rs1 = .Execute("EXECUTE GetCostFIFO 30;")
Dim rs2 As Object
Set rs2 = .Execute("EXECUTE GetCostLIFO 30;")
MsgBox _
"FIFO cost (30 unit order): " & vbCr & rs1.GetString & vbCr & vbCr
& _
"LIFO cost (30 unit order): " & vbCr & rs2.GetString
rs1.Close
rs2.Close
.Execute _
"CREATE VIEW StockLevels (purchase_date, previous_qty, current_qty)
AS SELECT W1.purchase_date," & _
" SUM(IIF(W2.purchase_date < W1.purchase_date, W2.qty_on_hand, 0)),
SUM(IIF(W2.purchase_date" & _
" <= W1.purchase_date, W2.qty_on_hand, 0)) FROM WidgetInventory AS
W1, WidgetInventory" & _
" AS W2 WHERE W2.purchase_date <= W1.purchase_date GROUP BY
W1.purchase_date, W1.unit_price" & _
" ;"
.Execute _
"CREATE TABLE Picklists (order_nbr INTEGER NOT NULL PRIMARY KEY,
goal_qty INTEGER" & _
" NOT NULL, CHECK (goal_qty > 0), bin_nbr_1 INTEGER NOT NULL
UNIQUE, qty_on_hand_1" & _
" INTEGER DEFAULT 0 NOT NULL, CHECK (qty_on_hand_1 >= 0), bin_nbr_2
INTEGER NOT NULL" & _
" UNIQUE, qty_on_hand_2 INTEGER DEFAULT 0 NOT NULL, CHECK
(qty_on_hand_2 >= 0), bin_nbr_3" & _
" INTEGER NOT NULL UNIQUE, qty_on_hand_3 INTEGER DEFAULT 0 NOT
NULL, CHECK (qty_on_hand_3" & _
" >= 0), CONSTRAINT not_over_goal CHECK (qty_on_hand_1 +
qty_on_hand_2 + qty_on_hand_3" & _
" <= goal_qty), CONSTRAINT bins_sorted CHECK (qty_on_hand_1 >=
qty_on_hand_2 AND" & _
" qty_on_hand_2 >= qty_on_hand_3));"
.Execute _
"INSERT INTO WidgetInventory (receipt_nbr, purchase_date,
qty_on_hand, unit_price)" & _
" VALUES (-1, '1990-01-01', 0 ,0.00);"
.Execute _
"INSERT INTO WidgetInventory (receipt_nbr, purchase_date,
qty_on_hand, unit_price)" & _
" VALUES (-2, '1990-01-02', 0 ,0.00);"
.Execute _
"CREATE VIEW PickCombos(total_pick, bin_1, qty_on_hand_1, bin_2,
qty_on_hand_2, bin_3," & _
" qty_on_hand_3) AS SELECT DISTINCT (W1.qty_on_hand +
W2.qty_on_hand + W3.qty_on_hand)" & _
" AS total_pick, IIF(W1.receipt_nbr < 0, 0, W1.receipt_nbr) AS
bin_1, W1.qty_on_hand," & _
" IIF(W2.receipt_nbr < 0, 0, W2.receipt_nbr) AS bin_2,
W2.qty_on_hand, IIF(W3.receipt_nbr" & _
" < 0, 0, W3.receipt_nbr) AS bin_3, W3.qty_on_hand FROM
WidgetInventory AS W1, WidgetInventory" & _
" AS W2, WidgetInventory AS W3 WHERE W1.receipt_nbr NOT IN
(W2.receipt_nbr, W3.receipt_nbr)" & _
" AND W2.receipt_nbr NOT IN (W1.receipt_nbr, W3.receipt_nbr) AND
W1.qty_on_hand >=" & _
" W2.qty_on_hand AND W2.qty_on_hand >= W3.qty_on_hand;"
.Execute _
"CREATE PROCEDURE OverPick (goal_qty INTEGER) AS SELECT goal_qty,
total_pick, bin_1," & _
" qty_on_hand_1, bin_2, qty_on_hand_2, bin_3, qty_on_hand_3 FROM
PickCombos WHERE" & _
" total_pick = (SELECT MIN (total_pick) FROM PickCombos WHERE
total_pick >= goal_qty)" & _
" AND goal_qty > 0;"
Set rs1 = .Execute("EXECUTE OverPick 50;")
Dim sCols As String
Dim f As Object
For Each f In rs1.Fields
sCols = sCols & f.Name & " = " & f.Value & vbCr & vbCr
Next
sCols = Left$(sCols, Len(sCols) - Len(vbCr & vbCr))
MsgBox _
"OVERPICK 50:" & vbCr & vbCr & _
sCols
rs1.Close
End With
Set .ActiveConnection = Nothing
End With
End Sub
Jamie.
--
