· 6 years ago · Mar 25, 2019, 10:18 AM
1'The SQL data and syntax imported into the VBA.Net code
2Imports System.Data
3Imports MySql.Data
4Imports MySql.Data.MySqlClient
5
6Public Class Main
7 'code in order to connect the vba code to the MySQL database
8 Dim cmd As MySqlCommand
9 Dim sbCmd As New System.Text.StringBuilder
10 Public connStr As String = "server=127.0.0.1;database=stockmanagementsystem;port=3306;"
11 Public conn As New MySqlConnection(connStr)
12 Dim items As New List(Of Item)
13 Dim ds As New DataSet
14 Sub SetUpDB()
15 'A serise of DDL statements to set up the database
16 'These are to create the tables
17 Try
18 MsgBox("Connected to MySQL...")
19 conn.Open()
20 ' Create CurrentStock========================
21
22 'StockDetails
23 sbCmd.Append("Create Table If Not Exists StockItems ")
24 sbCmd.Append("(StockID int PRIMARY KEY, ItemName VarChar(25), Price DECIMAL, Weight VarChar(10))")
25 cmd = New MySqlCommand(sbCmd.ToString, conn)
26 cmd.ExecuteNonQuery()
27 sbCmd.Clear()
28 'StockLevel=========================================
29 sbCmd.Append("Create Table If Not Exists StockLevel ")
30 sbCmd.Append("(StockID VarChar(13) PRIMARY KEY, Qty int, DateStamp DATE)")
31 cmd = New MySqlCommand(sbCmd.ToString, conn)
32 cmd.ExecuteNonQuery()
33 sbCmd.Clear()
34 '=============Deliveries
35 sbCmd.Append("Create Table If Not Exists Deliveries ")
36 sbCmd.Append("(StockID int PRIMARY KEY,QTY int ,DateTimeDelivered DATE)")
37 cmd = New MySqlCommand(sbCmd.ToString, conn)
38 cmd.ExecuteNonQuery()
39 sbCmd.Clear()
40 '=============SalesAndPreviousSales
41 sbCmd.Append("Create Table If Not Exists SalesAndPreviousSales ")
42 sbCmd.Append("(Sales VarChar(6), PreviousSales VarChar(5), Total Decimal, PRIMARY KEY (Sales, PreviousSales))") 'NB composite key syntax
43 cmd = New MySqlCommand(sbCmd.ToString, conn)
44 cmd.ExecuteNonQuery()
45 sbCmd.Clear()
46 '=============SalesAnalysis
47 sbCmd.Append("Create Table If Not Exists SalesAnalysis ")
48 sbCmd.Append("(HighestSales VarChar(6), LowestSales VarChar(5), PRIMARY KEY (HighestSales, LowestSales))") 'NB composite key syntax
49 cmd = New MySqlCommand(sbCmd.ToString, conn)
50 cmd.ExecuteNonQuery()
51 sbCmd.Clear()
52 '=============OrderTable
53 sbCmd.Append("Create Table If Not Exists Orders")
54 sbCmd.Append("(OrderID VarChar(6), OrderDate VarChar(5), PRIMARY KEY (OrderID))")
55 cmd = New MySqlCommand(sbCmd.ToString, conn)
56 cmd.ExecuteNonQuery()
57 sbCmd.Clear()
58
59 '=============StockCheck
60 sbCmd.Append("Create Table If Not Exists StockCheck")
61 sbCmd.Append("(StockID int, DateTimeCheck DATE, Quantity int, PRIMARY KEY (StockID, DateTimeCheck))")
62 cmd = New MySqlCommand(sbCmd.ToString, conn)
63 cmd.ExecuteNonQuery()
64 sbCmd.Clear()
65 conn.Close()
66 Catch ex As Exception
67 MsgBox("Connection unsuccessful")
68 End Try
69
70 End Sub
71 'This Sub is used in order to read items from the MySQL database and output them into the Web browser in the Forms window
72 Sub TestSQL()
73 Dim Reader As MySqlDataReader
74 conn.Open()
75 'Reads my SQL data
76 Dim sbDataTable As New System.Text.StringBuilder
77 sbCmd.Clear()
78 sbDataTable.Append("<table border='1' width='100%'><tr><td>StockId</td><td>itemname</td><td>price<td></td></tr>") ' Html code in order to set up the table in the web browser
79 'statement used in order to gather data from StockItems field on the database
80 sbCmd.Append("Select * from stockItems ORDER by StockId ASC ") 'selects stockitems from the database
81
82 cmd = New MySqlCommand(sbCmd.ToString, conn)
83 Reader = cmd.ExecuteReader()
84 Dim tempitem As New Item ' Reads SQL data and builds a html table
85 While Reader.Read()
86 tempitem.Id = Reader("StockId")
87 tempitem.Name = Reader("itemname")
88 tempitem.Price = Reader("price")
89 tempitem.Price = Reader("price")
90 sbDataTable.Append("<tr><td>" & tempitem.Id & "</td><td>" & tempitem.Name & "</td><td>" & tempitem.Price & "</td></tr>")
91 items.Add(tempitem)
92 End While
93 WB.DocumentText = sbDataTable.ToString() 'outputs html table to web browser
94 Reader.Close()
95 sbCmd.Clear()
96 End Sub
97 Private Sub Main_Load(sender As Object, e As EventArgs) Handles MyBase.Load
98 ' MsgBox("system loaded")
99 'CurrentItemsindatabase.Show()
100 'SetUpDB() 'can be uncommented in order to add new tables, but once set up it is no longer needed
101 TestSQL()
102 End Sub
103
104
105
106
107 '------------------- Enter data button for the adding the items
108 Private Sub AddItemEnter_Click(sender As Object, e As EventArgs) Handles AddItemEnter.Click
109 Try
110 ' assigns variables to a text box for the user to enter their data
111 Dim StockIDItem As Integer = txtID.Text
112 Dim WeightItem As Integer = txtWeight.Text
113 Dim PriceItem As Decimal = txtPrice.Text
114 Dim ItemName As String = txtName.Text
115 sbCmd.Clear()
116
117 sbCmd.Append("INSERT INTO `stockitems` (`StockID`, `ItemName`, `Price`, `Weight`) VALUES(@SID,@ItemName,@Price,@Weight")
118 'sbCmd.Append("('" & StockIDItem & "', '" & ItemName & "', '" & Price & "', '" & Weight & "');")
119 cmd = New MySqlCommand(sbCmd.ToString, conn)
120 cmd.Parameters.AddWithValue("@SID", StockIDItem)
121 cmd.Parameters.AddWithValue("@ItemName", ItemName)
122 cmd.Parameters.AddWithValue("@Price", PriceItem)
123 cmd.Parameters.AddWithValue("@Weight", WeightItem)
124 cmd.ExecuteNonQuery()
125 MessageBox.Show("Item has been entered")
126 Catch ex As Exception
127 MsgBox("Please enter valid data")
128 End Try
129
130 End Sub
131 ' links to code for each button as a reference
132 Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
133 Deliveries.Show()
134 End Sub
135
136 Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
137 EPOS.Show()
138 End Sub
139
140 Private Sub Orders_Click(sender As Object, e As EventArgs) Handles btnorder.Click
141 Orders.Show()
142 End Sub
143
144 Private Sub BtnStockCheck_Click(sender As Object, e As EventArgs)
145 StockCheck.Show()
146 End Sub
147
148 Private Sub BtnStockLevel_Click(sender As Object, e As EventArgs) Handles BtnStockLevel.Click
149 BtnStockItem.Show()
150 End Sub
151
152 Private Sub BtnDelItems_Click(sender As Object, e As EventArgs) Handles BtnDelItems.Click
153 sbCmd.Clear()
154 sbCmd.Append("DELETE FROM `stockitems` WHERE `StockID` = @SID")
155 cmd = New MySqlCommand(sbCmd.ToString, conn)
156 cmd.Parameters.AddWithValue("@SID", txtID.Text)
157
158 cmd.ExecuteNonQuery()
159 conn.Close()
160 TestSQL()
161
162
163 End Sub
164
165 Private Sub Regression_Click(sender As Object, e As EventArgs) Handles Regression.Click
166 Try 'try catch used to validate the regression input of the stockid if nothing is entered or an exception is thrown
167 Dim RegressionStockID As Integer = TxtStockIDRegression.Text
168 Dim SQLRetrieveDate As String = "SELECT Quantity, DateTimeSold from sales where stockid = @sid" 'Reads sales data from database
169 Dim salesreader As MySqlDataReader
170 Dim sales As New List(Of Sale) 'adds a list of sales data from the database for the algorith to process
171 Dim RegressionPoints As New List(Of RegPoint)
172 Dim RateOfSales, StockatStratOfCalculation, currentStock, regressionStartstockQty As Double
173 StockatStratOfCalculation = 200
174 currentStock = 0
175 cmd = New MySqlCommand(SQLRetrieveDate, conn)
176 cmd.Parameters.AddWithValue("@sid", RegressionStockID)
177 salesreader = cmd.ExecuteReader
178 While salesreader.Read()
179 sales.Add(New Sale(RegressionStockID, salesreader("Quantity"), salesreader("Datetimesold"))) 'adds sales data to a variable
180 End While
181 For Each sale In sales
182 currentStock = currentStock - sale.QtyOfSales
183 RegressionPoints.Add(New RegPoint(sale.DateTimeSold, currentStock))
184 Next
185 MsgBox(" Error = " & LinearLeastSquaresCalc(RegressionPoints, RateOfSales, regressionStartstockQty) & " Gradient = " & RateOfSales & " Intercept= " & regressionStartstockQty) 'outputs data into a message box when button is clicked
186 salesreader.Close()
187 conn.Close()
188 Catch ex As Exception
189 MsgBox("Enter a valid StockID") ' shows the user that their input was wrong
190 End Try
191 End Sub
192
193 Public Function DaysTillOutofstock(ByVal currentStock As Integer, ByVal salerate As Single)
194 'salerate is sales per day
195 'days left = currentStock/sales rate
196 DaysTillOutofstock = currentStock / salerate
197 End Function
198 Public Function LinearLeastSquaresCalc(ByVal DataPoints As List(Of RegPoint), ByRef Gradient As Double, ByRef Intercept As Double) As Double
199 ' Performs the calculation.
200 ' Find the values simplifiedx ect....
201 Dim Simplified1 As Double = DataPoints.Count
202 Dim Simplifiedx As Double = 0
203 Dim Simplifiedy As Double = 0
204 Dim Simplifiedxx As Double = 0
205 Dim Simplifiedxy As Double = 0
206 For Each DataPoint As RegPoint In DataPoints
207 Simplifiedx += DataPoint.x
208 Simplifiedy += DataPoint.y
209 Simplifiedxx += DataPoint.x * DataPoint.x
210 Simplifiedxy += DataPoint.x * DataPoint.y
211 Next
212
213 ' Solve for Gradient and Intercept.
214 Gradient = (Simplifiedxy * Simplified1 - Simplifiedx * Simplifiedy) / (Simplifiedxx * Simplified1 - Simplifiedx * Simplifiedx)
215 Intercept = (Simplifiedxy * Simplifiedx - Simplifiedy * Simplifiedxx) / (Simplifiedx * Simplifiedx - Simplified1 * Simplifiedxx)
216
217 Return Math.Sqrt(ESqrd(DataPoints, Gradient, Intercept)) ' this function actually returns the error not the gradient
218 End Function
219 Public Function ESqrd(ByVal DataPoints As List(Of RegPoint), ByVal Gradient As Double, ByVal Intercept As Double) As Double 'The error squared sub produces a value that shows how accurate the sales are, the higher the error the least accurate
220 Dim total As Double = 0
221 For Each DataPoint As RegPoint In DataPoints
222 Dim yDiff As Double = DataPoint.y - (Gradient * CDbl(DataPoint.x) + Intercept)
223 total += yDiff ^ 2
224 Next
225 Return total
226 End Function
227
228 Class RegPoint
229 Property Sale As Date
230 Property x As Single
231 Property y As Single
232 Sub New(ByVal saleDate As Date, y As Single)
233 Dim interval As TimeSpan = saleDate - #01/01/2019#
234 Me.x = interval.Days()
235 Me.y = y
236 End Sub
237 End Class
238
239
240End Class
241
242Class Item
243 Property Id As Integer
244 Property Name As String
245 Property Price As Decimal
246 Property Weight As Single
247 Property Sales As List(Of Sale)
248 Property StockLevels As List(Of Stocklevel)
249 Property Deliveryitems As List(Of Delivery)
250 Property OrderItems As List(Of OrdersClass)
251End Class
252
253Class Stocklevel 'classes used for item reader for MySQL
254 Property StockId As Integer
255 Property Qtyitem As Integer
256 Property Datestamp As Date
257End Class
258Class Sale 'classes used for item reader for MySQL
259
260
261 Property StockIdSales As Integer
262 Property QtyOfSales As Integer
263 Property DateTimeSold As DateTime
264 Sub New(id, qty, dateNtime) 'Class used for regression
265 Me.StockIdSales = id
266 Me.QtyOfSales = qty
267 Me.DateTimeSold = dateNtime
268 End Sub
269End Class
270Class Delivery 'classes used for item reader for MySQL
271 Property StockIDDelivery As Integer
272 Property QTYDelivery As Integer
273 Property Datetimedelivered As DateTime
274End Class
275Class OrdersClass 'classes used for item reader for MySQL
276 Property OrderIDItem As Integer
277 Property OrderDateItem As Date
278End Class
279Class StockCheckClass 'classes used for item reader for MySQL
280 Property StockIDCheck As Integer
281 Property DateTimeCheck As DateTime
282 Property QuantityCheck As Integer
283End Class