Good morning all,
I have inherited an Access Database with some VBA (and yes I am terrible with VBA).
1) Upon running the Code in the database I get an error:
2) Upon debugging the Code it is falling over at the following line:
I have included the code below. Any thoughts?
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim rst As Recordset
Dim iRow As Long
Dim Y(20) As String
Dim QBActive As Boolean
'--- open the workbook
Set objXL = New Excel.Application
objXL.Visible = True
Set objWkb = objXL.Workbooks.Open("C:\Greentree\Printblocks\Excel\QuantityBreaksTemplate.xltx")
Set objSht = objWkb.Worksheets("QuantityBreaks")
iRow = 2 ' as there is a header
Set rst = CurrentDb.OpenRecordset("SELECT StockItem.code, StockItem.description, INSellingPrice.netPrice, QuantityBreaksDiscount.price, QuantityBreaksDiscount.isActive, QuantityBreaksDiscount.quantity, StockItem.quantityAvailable FROM ((((QuantityBreaksDiscount RIGHT JOIN (INSellingPrice RIGHT JOIN StockItem ON INSellingPrice.myStockItem = StockItem.oid) ON QuantityBreaksDiscount.myINSellingPrice = INSellingPrice.oid) LEFT JOIN StockItem_allTreeZones ON StockItem.oid = StockItem_allTreeZones.stockItem_oid) LEFT JOIN TreeZone ON StockItem_allTreeZones.treeZone_oid = TreeZone.oid) LEFT JOIN Tree ON TreeZone.myTree = Tree.oid) LEFT JOIN Tree AS Tree_1 ON Tree.myTreeRoot = Tree_1.oid WHERE ((INSellingPrice.isActive)=True) AND ((Tree_1.name)='Product By Manufacturer') ORDER BY StockItem.code, QuantityBreaksDiscount.isActive, QuantityBreaksDiscount.quantity")
rst.MoveFirst
X = 0
Do While Not rst.EOF
X = X + 1
Y(X) = rst!code
QBActive = rst!isActive
If Y(X) = Y(X - 1) And QBActive = True Then
objSht.Cells(iRow - 1, (2 * X) + 3).Value = rst!quantity
objSht.Cells(iRow - 1, (2 * X) + 4).Value = rst!price
GoTo 10
End If
If Y(X) = Y(X - 1) Then GoTo 10
X = 1
Y(X) = rst!code
objSht.Cells(iRow, 1).Value = rst!code
objSht.Cells(iRow, 2).Value = rst!Description
objSht.Cells(iRow, 3).Value = rst!netPrice
objSht.Cells(iRow, 4).Value = rst!quantityAvailable
objSht.Cells(iRow, 5).Value = rst!quantity
objSht.Cells(iRow, 6).Value = rst!price
iRow = iRow + 1
10 rst.MoveNext
Loop
objSht.Columns("A
").EntireColumn.AutoFit
If Dir("C:\Greentree\Printblocks\Excel\DailyPriceListReport.xlsx") <> "" Then
Kill ("C:\Greentree\Printblocks\Excel\DailyPriceListReport.xlsx")
End If
objWkb.SaveAs FileName:="C:\Greentree\Printblocks\Excel\DailyPriceListReport.xlsx", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
objXL.Quit
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
rst.Close
DoCmd.Quit
End Sub
I have inherited an Access Database with some VBA (and yes I am terrible with VBA).
1) Upon running the Code in the database I get an error:
runtime error '50290' application-defined....2) Upon debugging the Code it is falling over at the following line:
objSht.Cells(iRow, 3).Value = rst!netPriceI have included the code below. Any thoughts?
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim rst As Recordset
Dim iRow As Long
Dim Y(20) As String
Dim QBActive As Boolean
'--- open the workbook
Set objXL = New Excel.Application
objXL.Visible = True
Set objWkb = objXL.Workbooks.Open("C:\Greentree\Printblocks\Excel\QuantityBreaksTemplate.xltx")
Set objSht = objWkb.Worksheets("QuantityBreaks")
iRow = 2 ' as there is a header
Set rst = CurrentDb.OpenRecordset("SELECT StockItem.code, StockItem.description, INSellingPrice.netPrice, QuantityBreaksDiscount.price, QuantityBreaksDiscount.isActive, QuantityBreaksDiscount.quantity, StockItem.quantityAvailable FROM ((((QuantityBreaksDiscount RIGHT JOIN (INSellingPrice RIGHT JOIN StockItem ON INSellingPrice.myStockItem = StockItem.oid) ON QuantityBreaksDiscount.myINSellingPrice = INSellingPrice.oid) LEFT JOIN StockItem_allTreeZones ON StockItem.oid = StockItem_allTreeZones.stockItem_oid) LEFT JOIN TreeZone ON StockItem_allTreeZones.treeZone_oid = TreeZone.oid) LEFT JOIN Tree ON TreeZone.myTree = Tree.oid) LEFT JOIN Tree AS Tree_1 ON Tree.myTreeRoot = Tree_1.oid WHERE ((INSellingPrice.isActive)=True) AND ((Tree_1.name)='Product By Manufacturer') ORDER BY StockItem.code, QuantityBreaksDiscount.isActive, QuantityBreaksDiscount.quantity")
rst.MoveFirst
X = 0
Do While Not rst.EOF
X = X + 1
Y(X) = rst!code
QBActive = rst!isActive
If Y(X) = Y(X - 1) And QBActive = True Then
objSht.Cells(iRow - 1, (2 * X) + 3).Value = rst!quantity
objSht.Cells(iRow - 1, (2 * X) + 4).Value = rst!price
GoTo 10
End If
If Y(X) = Y(X - 1) Then GoTo 10
X = 1
Y(X) = rst!code
objSht.Cells(iRow, 1).Value = rst!code
objSht.Cells(iRow, 2).Value = rst!Description
objSht.Cells(iRow, 3).Value = rst!netPrice
objSht.Cells(iRow, 4).Value = rst!quantityAvailable
objSht.Cells(iRow, 5).Value = rst!quantity
objSht.Cells(iRow, 6).Value = rst!price
iRow = iRow + 1
10 rst.MoveNext
Loop
objSht.Columns("A
").EntireColumn.AutoFitIf Dir("C:\Greentree\Printblocks\Excel\DailyPriceListReport.xlsx") <> "" Then
Kill ("C:\Greentree\Printblocks\Excel\DailyPriceListReport.xlsx")
End If
objWkb.SaveAs FileName:="C:\Greentree\Printblocks\Excel\DailyPriceListReport.xlsx", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
objXL.Quit
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
rst.Close
DoCmd.Quit
End Sub
