Auto generate alpha numeric in VB.NET - sql-server

I'm currently working on my project for which I used VB.NET 2019 and SQL server. I need to create a function which auto generates IDs.
I want my IDs to be like these: P001, P002, P003 etc. Can someone show me how to code it? Below is my code
Private Sub Form4_Load_1(sender As Object, e As EventArgs) Handles MyBase.Load
BindData()
Dim data As String = "Data Source=LAPTOP-M8KKSG0I;Initial Catalog=Oceania;Integrated Security=True"
Dim con As New SqlConnection(data)
Try
If Con.State = ConnectionState.Closed Then
con.Open()
End If
Dim sql As String = "Select Max(PatientID) from Patient"
Dim cmd As New SqlCommand(sql, con)
Dim Max As String = cmd.ExecuteScalar
If Max > 0 Then
TextBox1.Text = Max + 1
Else
TextBox1.Text = "P01"
End If
Catch ex As Exception
MsgBox(Err.Description)
End Try
End Sub

You can try like this. Here 1 is an auto-generated number that may be an identity key column value from a table in SQL Server.
Dim number As Integer = 1
Dim numberText As String = "P" & number.ToString().PadLeft(3, "0")
Live demo
You can add a computed column like this in your table for auto-generating the sequences. This will reduce the chances of duplicate value runtime once more than one person will do the entry simultaneously.
Alter table Patient ADD PatientCode AS ('P' + Convert(Varchar(3),CONCAT(REPLICATE('0', 3 - LEN(PatientID)), PatientID)) )
To get the column value dynamically you can try the below code to generate function.
Private Sub GenerateSequnce()
Dim constring As String = "Data Source=TestServer;Initial Catalog=TestDB;User id = TestUser;password=test#123"
Using con As New SqlConnection(constring)
Using cmd As New SqlCommand("Select Top 1 ISNULL(TaxCode, 0) from Tax_Mst Order By TaxCode Desc", con)
cmd.CommandType = CommandType.Text
Using sda As New SqlDataAdapter(cmd)
Using dt As New DataTable()
sda.Fill(dt)
Dim maxNumberCode = dt.Rows(0)("TaxCode").ToString()
If (maxNumberCode = "0") Then
maxNumberCode = "1"
End If
Dim numberText As String = "P" & maxNumberCode.ToString().PadLeft(3, "0")
End Using
End Using
End Using
End Using
End Sub
Here the column TaxCode is int with identity constraint.
With the minor correction in your code, you can achieve this as shown below.
Dim data As String = "Data Source=LAPTOP-M8KKSG0I;Initial Catalog=Oceania;Integrated Security=True"
Dim con As New SqlConnection(data)
Try
If con.State = ConnectionState.Closed Then
con.Open()
End If
Dim sql As String = "Select ISNULL(Max(PatientID), 0) from Patient"
Dim cmd As New SqlCommand(sql, con)
Dim Max As String = cmd.ExecuteScalar
If (Max = "0") Then
Max = "1"
Else
Max = CInt(Max) + 1
End If
Dim numberText As String = "P" & Max.ToString().PadLeft(3, "0")
TextBox1.Text = numberText
Catch ex As Exception
MsgBox(Err.Description)
End Try
OUTPUT

Related

Is there any code to change value of dim function

I want to put data in SQL table through vb.net in two columns which are Txn_Amount and Post_Amount
where textbox3 = Txn_Amount
Post Amount = Textbox4 - textbox3
but I want if textbox4 = "" than Post amount should be 0
This is my code:
Call Get_TxnID()
Dim Txn_Amount As String = TextBox3.Text
Dim Post_Amount As String = Val(TextBox4.Text) - Val(TextBox3.Text)
Dim query As String = "Insert into Txn_Master values (#Txn_Amount, #Post_Amount)"
Using cmd As New SqlCommand(query, Connection)
cmd.Parameters.AddWithValue("Txn_Amount", Txn_Amount)
cmd.Parameters.AddWithValue("Post_Amount", Post_Amount)
Connection.Open()
cmd.ExecuteNonQuery()
Connection.Close()
End Using
MsgBox("Transaction Success", MsgBoxStyle.Information)
It work well when i have value in both boxes For example :- textbox3.text = 25000 and textbox4.text = 50000 then Post_Amount is 25000
but if textbox3.text = 25000 and textbox4.text = "" then it shows -25000 in post_amount but i want if textbox4 = "" then post amount should be "" or "0"
I have tried
Dim Txn_Amount As String = TextBox3.Text
If textbox4.text="" then
Dim Post_Amount As String = ""
Else
Dim Post_Amount As String = Val(TextBox4.Text) - Val(TextBox3.Text)
endif
Dim query As String = "Insert into Txn_Master values (#Txn_Amount, #Post_Amount)"
Using cmd As New SqlCommand(query, Connection)
cmd.Parameters.AddWithValue("Txn_Amount", Txn_Amount)
cmd.Parameters.AddWithValue("Post_Amount", Post_Amount)
Connection.Open()
cmd.ExecuteNonQuery()
Connection.Close()
End Using
MsgBox("Transaction Success", MsgBoxStyle.Information)
But it is now working, please help me with this
If you initialise a variable for "Post_Amount" to zero, then you can check if the appropriate TextBox has an entry before setting its value, something like this:
Dim txnAmount As Integer = 0
If Not Integer.TryParse(tbTxnAmount.Text, txnAmount) Then
' Prompt user to enter an appropriate value in the TextBox.
' Exit Sub
End If
Dim postAmount As Integer = 0
'TODO Use sensible names for tbAmountA and tbAmountB.
If Not String.IsNullOrWhiteSpace(tbAmountB.Text) Then
'TODO: Use sensible names for these variables.
Dim a = 0
Dim b = 0
If Integer.TryParse(tbAmountA.Text, a) AndAlso Integer.TryParse(tbAmountB.Text, b) Then
postAmount = b - a
End If
End If
Using conn As New SqlConnection("your connection string")
Dim sql = "INSERT INTO [Txn_Master] VALUES (#Txn_Amount, #Post_Amount)"
Using cmd As New SqlCommand(sql, conn)
cmd.Parameters.Add(New SqlParameter With {.ParameterName = "#Txn_Amount",
.SqlDbType = SqlDbType.Int,
.Value = txnAmount})
cmd.Parameters.Add(New SqlParameter With {.ParameterName = "#Post_Amount",
.SqlDbType = SqlDbType.Int,
.Value = postAmount})
conn.Open()
cmd.ExecuteNonQuery()
cmd.Clone()
End Using
End Using
I strongly recommend that you use meaningful names for the TextBoxes and variables. "tbAmountB" is your "TextBox4", but it still needs a better name.
Strictly speaking, it doesn't need the String.IsNullOrWhiteSpace test as such a string would fail the parsing, but it does leave the intent clear.
Also, to make your code easier for others to read, it is convention to use camelCase for variable names: Capitalization Conventions.

"System.OutOfMemoryException: 'Out of memory.'" when reading image from SQL Server

I have images assigned to every button in my VB.NET form, the images come from SQL Server. The data type is varbinary(MAX).
This is my code:
Using con As New SqlConnection("con string")
Dim sql As String = "SELECT * FROM Inventory WHERE ID=#ID"
Using cmd As New SqlCommand(sql, con)
cmd.Parameters.Add("#ID", SqlDbType.VarChar).Value = 3
con.Open()
Using myreader As SqlDataReader = cmd.ExecuteReader()
If myreader.Read() AndAlso Not DBNull.Value.Equals(myreader("Image")) Then
Boton3.Text = myreader("Item")
Boton3.Enabled = myreader("ONOFF")
Dim ImgSql() As Byte = DirectCast(myreader("Image"), Byte())
Using ms As New MemoryStream(ImgSql)
Boton3.BackgroundImage = Image.FromStream(ms)
con.Close()
End Using
Else
Boton3.Text = myreader("Item")
Boton3.BackgroundImage = Nothing
Boton3.Enabled = myreader("ONOFF")
End If
End Using
End Using
End Using
The platform is 64bit. I'm thinking it might have to do with not disposing properly, but I'm not sure since I'm new to coding.
EDIT SHOWING NEW CODE AND HOW I RETRIVE MORE THAN ONE RECORD:
Private Sub Button12_Click(sender As Object, e As EventArgs) Handles Button12.Click
Dim dt As DataTable
Try
dt = GetInventoryDataByID(1)
Catch ex As Exception
MessageBox.Show(ex.Message)
Exit Sub
End Try
If dt.Rows.Count > 0 Then
Boton1.Text = dt.Rows(0)("Articulo").ToString
Boton1.Enabled = CBool(dt.Rows(0)("ONOFF"))
If Not DBNull.Value.Equals(dt.Rows(0)("Imagen")) Then
Dim ImgSql() As Byte = DirectCast(dt.Rows(0)("Imagen"), Byte())
Using ms As New MemoryStream(ImgSql)
Boton1.BackgroundImage = Image.FromStream(ms)
End Using
Else
Boton1.BackgroundImage = Nothing
End If
Else
MessageBox.Show("No records returned")
End If
Dim dt2 As DataTable
Try
dt2 = GetInventoryDataByID(2)
Catch ex As Exception
MessageBox.Show(ex.Message)
Exit Sub
End Try
If dt2.Rows.Count > 0 Then
Boton2.Text = dt2.Rows(0)("Articulo").ToString
Boton2.Enabled = CBool(dt2.Rows(0)("ONOFF"))
If Not DBNull.Value.Equals(dt2.Rows(0)("Imagen")) Then
Dim ImgSql() As Byte = DirectCast(dt2.Rows(0)("Imagen"), Byte())
Using ms As New MemoryStream(ImgSql)
Boton2.BackgroundImage = Image.FromStream(ms)
End Using
Else
Boton2.BackgroundImage = Nothing
End If
Else
MessageBox.Show("No records returned")
End If
End Sub
Private Function GetInventoryDataByID(id As Integer) As DataTable
Dim dt As New DataTable
Dim sql As String = "SELECT Imagen, Articulo, ONOFF FROM Inventario WHERE ID=#ID"
Using con As New SqlConnection("CON STRING"),
cmd As New SqlCommand(sql, con)
cmd.Parameters.Add("#ID", SqlDbType.Int).Value = id
con.Open()
Using myreader As SqlDataReader = cmd.ExecuteReader()
dt.Load(myreader)
End Using
End Using
Return dt
End Function
End Class
You don't want to hold a connection open while you update the user interface. Separate you user interface code from your database code.
If you put a comma at the end of the first line of the outer Using block, both the command and the connection are included in same block. Saves a bit of indenting.
You are passing an integer to the #ID parameter but you have set the SqlDbType as a VarChar. Looks like a problem. I changed the SqlDbType to Int.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim dt As DataTable
Try
dt = GetInventoryDataByID(3)
Catch ex As Exception
MessageBox.Show(ex.Message)
Exit Sub
End Try
If dt.Rows.Count > 0 Then
Boton3.Text = dt.Rows(0)("Item").ToString
Boton3.Enabled = CBool(dt.Rows(0)("ONOFF"))
If Not DBNull.Value.Equals(dt.Rows(0)("Image")) Then
Dim ImgSql() As Byte = DirectCast(dt.Rows(0)("Image"), Byte())
Using ms As New MemoryStream(ImgSql)
Boton3.BackgroundImage = Image.FromStream(ms)
End Using
Else
Boton3.BackgroundImage = Nothing
End If
Else
MessageBox.Show("No records returned")
End If
End Sub
Private Function GetInventoryDataByID(id As Integer) As DataTable
Dim dt As New DataTable
Dim sql As String = "SELECT * FROM Inventory WHERE ID=#ID"
Using con As New SqlConnection("con string"),
cmd As New SqlCommand(sql, con)
cmd.Parameters.Add("#ID", SqlDbType.Int).Value = id
con.Open()
Using myreader As SqlDataReader = cmd.ExecuteReader()
dt.Load(myreader)
End Using
End Using
Return dt
End Function
EDIT Add Dispose on image
If Not DBNull.Value.Equals(dt.Rows(0)("Image")) Then
Dim ImgSql() As Byte = DirectCast(dt.Rows(0)("Image"), Byte())
Using ms As New MemoryStream(ImgSql)
If Boton3.BackgroundImage IsNot Nothing Then
Boton3.BackgroundImage.Dispose()
End If
Boton3.BackgroundImage = Image.FromStream(ms)
End Using
Else
If Boton3.BackgroundImage IsNot Nothing Then
Boton3.BackgroundImage.Dispose()
End If
End If
I resolved this issue by simply not using buttons. Instead I used pictureboxes as buttons and that resolved the issue. Im guesssing the problem is that buttons don't allow as much memory as pictureboxes.

MultipleActiveResultSets for SQL Server and VB.NET application

I am trying to get multiple data sets from SQL Server using a VB.NET application. The problem that every time I try to execute the query,
I get this message:
Cannot change property 'ConnectionString'. The current state of the connection is open
Then I tried to fix it by enabling MARS
<connectionStrings>
<add name="ConString"
providerName="System.Data.SqlClient"
connectionString="Data Source=my-PC;Initial Catalog=Project;Persist Security Info=True; MultipleActiveResultSets=true;User ID=user;Password=*****" />
</connectionStrings>
This is my code
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim obj, body
obj = TextBox1.Text
body = TextBox2.Text
For Each mail In getemail()
Send_mail(mail, obj, body, getattachment(mail))
Next
MsgBox("Traitement effectué")
End Sub
Function getemail() As List(Of String)
Dim strMailTo As New List(Of String)
Dim SQL As String = "Select EMail FROM [USER] WHERE EMail Is Not NULL And MatriculeSalarie Is Not NULL And [EMail] <> '' and EtatPaie = 3 and BulletinDematerialise = 1 "
Dim cmd As New SqlCommand
Dim sqLdr As SqlDataReader
Dim dr As DataRow
Try
ConnServer()
cmd.Connection = con
cmd.CommandText = SQL
Using sda As New SqlDataAdapter(cmd)
Using ds As New DataTable()
sda.Fill(ds)
sqLdr = cmd.ExecuteReader()
For i = 0 To ds.Rows.Count - 1
dr = ds.Rows(i)
strMailTo.Add(dr("EMail"))
Next
End Using
End Using
Return strMailTo
sqLdr.Close()
Catch ex As Exception
MsgBox(ex.Message.ToString)
End Try
closeCon()
Return strMailTo
End Function
Function getattachment(email) As String()
Dim SQL As String = "Select MatriculeSalarie FROM [USER] WHERE [EMail]='" & email & "'"
Dim cmd As New SqlCommand
Dim sqLdr As SqlDataReader
ConnServer()
cmd.Connection = con
cmd.CommandText = SQL
Dim mat As String
mat = ""
Dim Dir As String = ConfigurationManager.AppSettings("path1").ToString
Dim file()
sqLdr = cmd.ExecuteReader()
While sqLdr.Read
mat = sqLdr.GetValue(sqLdr.GetOrdinal("MatriculeSalarie"))
End While
file = IO.Directory.GetFiles(Dir, mat.Substring(1) & "*.pdf")
sqLdr.Close()
Return file
End Function
If all you are going to do is show a message box in a Catch, don't do it in the database code. Let the error bubble up to the user interface code and put the Try around where the method is called.
Do not declare variables without a DataType. The button code with Option Infer on sets the type of obj and body.
Private ConStr As String = "Your connection string"
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim obj = TextBox1.Text
Dim body = TextBox2.Text
Dim emails As New List(Of String)
Try
emails = getemail()
Catch ex As Exception
MessageBox.Show(ex.Message.ToString, "Error retrieving email list")
Exit Sub
End Try
For Each email In emails
Try
Send_mail(email, obj, body, getattachment(email))
Catch ex As Exception
MessageBox.Show(ex.Message, "Error getting attachments")
End Try
Next
MessageBox.Show("Traitement effectué")
End Sub
Parameters used by Sub and Function must have a DataType.
I don't know what you are doing here.
While sqLdr.Read
mat = sqLdr.GetValue(sqLdr.GetOrdinal("MatriculeSalarie"))
End While
Each iteration will overwrite the previous value of mat. I can only assume that you expect only a single value, in which case you can use ExecuteScalar to get the first column of the first row of the result set. Don't do anything with the data until after the connection is closed. Just get the raw data and close (End Using) the connection. Manipulate the data later.
Always use Parameters. Parameters are not treated as executable code by the database server. They are simply values. An example of executable code that could be inserted is "Drop table [USER];" where the value of a parameter belongs. Oops!
Function getemail() As List(Of String)
Dim SQL As String = "Select EMail FROM [USER]
WHERE EMail Is Not NULL
And MatriculeSalarie Is Not NULL
And [EMail] <> ''
And EtatPaie = 3
And BulletinDematerialise = 1;"
Dim dt As New DataTable
Using con As New SqlConnection("Your connection string"),
cmd As New SqlCommand(SQL, con)
con.Open()
Using reader = cmd.ExecuteReader
dt.Load(reader)
End Using
End Using
Dim strMailTo As New List(Of String)
strMailTo = (From row As DataRow In dt.AsEnumerable
Select row.Field(Of String)(0)).ToList
Return strMailTo
End Function
Function getattachment(email As String) As String()
Dim SQL As String = "Select MatriculeSalarie FROM [USER] WHERE [EMail]='" & email & "'"
Dim mat As String
Using con As New SqlConnection(ConStr),
cmd As New SqlCommand(SQL, con)
cmd.Parameters.Add("#email", SqlDbType.VarChar).Value = email
con.Open()
mat = cmd.ExecuteScalar().ToString()
End Using
Dim Dir As String = ConfigurationManager.AppSettings("path1").ToString
'Your original code was fine, no need for searchPattern.
'I added this so you could see if your search pattern was what you expected.
Dim searchPattern = mat.Substring(1) & "*.pdf"
Debug.Print(searchPattern) 'Appears in the Immediate window
Dim file = IO.Directory.GetFiles(Dir, searchPattern)
Return file
End Function

Query Timeout Expired when updating SQL Server from VB,NET

I'm updating SQL Server from VB.NET and keep getting the 'Query Timeout Error', I have lot's of sub routines that I run in sequence that look like the following:
Public Shared Sub Update_DailyRatings()
Dim stallStats As String = ""
Dim win As Integer = 0
Dim mSplit As Array
Dim cn As OleDbConnection = New OleDbConnection(MainForm.connectStringPublic)
cn.Open()
Dim selectString As String = "Select * FROM DailyRatings"
Dim cmd As OleDbCommand = New OleDbCommand(selectString, cn)
Dim reader As OleDbDataReader = cmd.ExecuteReader()
While (reader.Read())
stallStats = Get_Stall_Stats(reader("Track").ToString, CInt(reader("Stall")), CDbl(reader("Distance")))
If stallStats = "" Then
MainForm.NonQuery("UPDATE DailyRatings SET StallWin = 999 WHERE Horse = '" & reader("Horse").ToString & "'")
Else
mSplit = Split(stallStats, ",")
win = mSplit(0)
MainForm.NonQuery("UPDATE DailyRatings SET StallWin = " & win & " WHERE Horse = '" & reader("Horse").ToString & "'")
End If
End While
reader.Close()
cn.Close()
End Sub
The NonQuery sub looks like this:
Public Sub NonQuery(ByVal SQL As String)
Dim query As String = SQL
Try
Dim cn3 As OleDbConnection = New OleDbConnection(connectStringPublic)
cn3.Open()
Dim cmd As OleDbCommand = New OleDbCommand(query, cn3)
cmd.CommandTimeout = 90
cmd.ExecuteNonQuery()
cn3.Close()
cn3.Dispose()
cmd.Dispose()
OleDbConnection.ReleaseObjectPool()
Catch e As System.Exception
Clipboard.SetText(query)
MsgBox(e.Message)
Finally
End Try
End Sub
As you can see I've been trying ideas to fix this that I found in other threads such as extending the timeout and using the Dispose() and ReleaseObjectPool() methods but it hasn't worked, I still get query timeout error at least once when running all my subs in sequence, it's not always the same sub either.
I recently migrated from Access, this never used to happen with Access.
If you are dealing with Sql Server why are you using OleDb? I guessed that is was really access.
While your DataReader is open, your connection remains open. With the amount of processing you have going on, it is no wonder that your connection is timing out.
To begin, connections and several other database objects need to be not only closed but disposed. They may contain unmanaged resources which are released in the .Dispose method. If you are using an object that exposes a .Dispose method use Using...End Using blocks. This will take care of this problem even if there is an error.
Actually you have 2 distinct operations going on. First you are retrieving DailyRatings and then you are updating DailyRatings base on the data retrieved. So we fill a Datatable with the first chunk of data and pass it off to the second operation. Our first connection is closed and disposed.
In operation 2 we create our connection and command objects just as before except now our command has parameters. The pattern of the command is identical for every .Execute, only the values of the parameters change. This pattern allows the database, at least in Sql Sever, to cache a plan for the query and improve performance.
Public Shared Function GetDailyRatings() As DataTable
Dim dt As New DataTable
Using cn As New OleDbConnection(MainForm.connectStringPublic),
cmd As New OleDbCommand("Select * FROM DailyRatings", cn)
cn.Open()
dt.Load(cmd.ExecuteReader)
End Using
Return dt
End Function
Public Sub UpdateDailyRatings()
Dim dt = GetDailyRatings()
Using cn As New OleDbConnection(connectStringPublic),
cmd As New OleDbCommand("UPDATE DailyRatings SET StallWin = #Stall WHERE Horse = #Horse")
cmd.Parameters.Add("#Stall", OleDbType.Integer)
cmd.Parameters.Add("#Horse", OleDbType.VarChar)
cn.Open()
For Each row As DataRow In dt.Rows
cmd.Parameters("#Horse").Value = row("Horse").ToString
Dim stallStats As String = Get_Stall_Stats(row("Track").ToString, CInt(row("Stall")), CDbl(row("Distance")))
If stallStats = "" Then
cmd.Parameters("#Stall").Value = 999
Else
cmd.Parameters("#Stall").Value = CInt(stallStats.Split(","c)(0))
End If
cmd.ExecuteNonQuery()
Next
End Using
End Sub
Private Function GetStallStats(Track As String, Stall As Integer, Distance As Double) As String
Dim s As String
'Your code here
Return s
End Function
Note: OleDb does not pay attention to parameters names. It is the order that they appear in the query statement must match the order that they are added to the Parameters collection.
It's possible that OleDbDataReader is locking your table or connection as it get the data with busy connection. You can store the data in a DataTable by using OleDbDataAdapter and loop through it to run your updates. Below is the snippet how your code would look like:
Dim cmd As OleDbCommand = New OleDbCommand(selectString, cn)
Dim adapter As OleDbDataAdapter = New OleDbDataAdapter(cmd)
Dim dt As New DataTable()
adapter.Fill(dt)
For Each reader As DataRow In dt.Rows
stallStats = Get_Stall_Stats(reader("Track").ToString, CInt(reader("Stall")), CDbl(reader("Distance")))
If stallStats = "" Then
MainForm.NonQuery("UPDATE DailyRatings SET StallWin = 999 WHERE Horse = '" & reader("Horse").ToString & "'")
Else
mSplit = Split(stallStats, ",")
win = mSplit(0)
MainForm.NonQuery("UPDATE DailyRatings SET StallWin = " & win & " WHERE Horse = '" & reader("Horse").ToString & "'")
End If
Next
cn.Close()

How to prevent array from adding (sum) together

I have an array. My program goes through and sets up the array. However, when I display the array,it's adding the arrays together.
Here is my code:
Public Class frmMain
Dim connetionString As String
Dim connection As SqlConnection
Dim command As SqlCommand
Dim adapter As New SqlDataAdapter
Dim ds As New DataSet
Dim sql As String
Dim yPoint As Integer
Dim LocationDB As String
Dim dtstartdate As Date
Dim dtenddate As Date
Dim LocationName As String
Dim BookSales(17) As Integer
Public Shared locationcounter As Integer
Dim i As Integer
Public Sub Get_Info()
If locationcounter < 18 Then
dtstartdate = dtpStartDate.Value
dtenddate = dtpEndDate.Value.AddDays(1).AddSeconds(-1)
Try
connetionString = "Data Source=" & LocationDB & ";Initial Catalog=test;Persist Security Info=True;User ID=sa;Password=test"
sql = "Select * from fGetdata"
connection = New SqlConnection(connetionString)
connection.Open()
command = New SqlCommand(sql, connection)
adapter.SelectCommand = command
adapter.SelectCommand.CommandTimeout = 130
adapter.SelectCommand.Parameters.AddWithValue("#StartDate", dtstartdate)
adapter.SelectCommand.Parameters.AddWithValue("#EndDate", dtenddate)
adapter.Fill(ds)
connection.Close()
connection.Dispose()
Catch ex As Exception
MsgBox(ex.Message)
End Try
For Each FoundRow As DataRow In ds.Tables(0).Rows
Select Case FoundRow("CategoryName")
Case "TOTAL"
Select Case FoundRow("Description")
Case "BOOK", "BOOK SALES", "GC"
BookSales(i) = BookSales(i) + (FoundRow("netAmt"))
End Select
End Select
Next
MsgBox(LocationName & BookSales(i))
MsgBox(LocationName & BookSales(0))
MsgBox(LocationName & BookSales(1))
End If
End Sub
Public Sub GetLocation()
Select Case locationcounter
Case "1"
LocationName = "Location1"
Locationdb = "10.0.1.52"
Case "2"
LocationName = "Location2"
Locationdb = "10.0.1.51"
Case "3"
LocationName = "Location3"
Locationdb = "10.0.1.50"
End Select
End Sub
Button Click:
For x = 1 To 3
GetLocation()
Label1.Text = LocationName
Label1.Refresh()
Get_Info()
i = i + 1
locationcounter = locationcounter + 1
Next
I am getting:
Location1 5
Location2 25
Location3 35
I would like to get:
Location1 5
Location2 20
Location3 10
For some reason the arrays are adding together
As you noted, the problem is that the DataSet was getting reused so it accumulated the results on each loop.
You need to clean up the coding style. Put things in as tight of scope as possible. In this case all the vars used by the Get_Info() method should be declared within the method. This prevents side effects from long living variables. The DataSet is only used in the Get_Info method so it should only exist there.
Clean up the resources in a Finally block. In the example below I moved the connection.Dispose into the finally block. You only need to call Dispose, you don't need the Close also.
You should also enable Option Strict and Option Explicit. These will help prevent casing errors that don't show up until runtime. As an example of type mismatch, you declare the loctioncounter as integer but use it as a string in the GetLocation method.
There are more but this should get you started in the right direction.
Public Class frmMain
Dim yPoint As Integer
Dim LocationDB As String
Dim dtstartdate As Date
Dim dtenddate As Date
Dim LocationName As String
Dim BookSales(17) As Integer
Public Shared locationcounter As Integer
Dim i As Integer
Public Sub Get_Info()
Dim connetionString As String
Dim connection As SqlConnection = Nothing
Dim command As SqlCommand
Dim adapter As New SqlDataAdapter
Dim ds As New DataSet
Dim sql As String
If locationcounter < 18 Then
dtstartdate = dtpStartDate.Value
dtenddate = dtpEndDate.Value.AddDays(1).AddSeconds(-1)
Try
connetionString = "Data Source=" & LocationDB & ";Initial Catalog=test;Persist Security Info=True;User ID=sa;Password=test"
sql = "Select * from fGetdata"
connection = New SqlConnection(connetionString)
connection.Open()
command = New SqlCommand(sql, connection)
adapter.SelectCommand = command
adapter.SelectCommand.CommandTimeout = 130
adapter.SelectCommand.Parameters.AddWithValue("#StartDate", dtstartdate)
adapter.SelectCommand.Parameters.AddWithValue("#EndDate", dtenddate)
adapter.Fill(ds)
For Each FoundRow As DataRow In ds.Tables(0).Rows
Select Case FoundRow("CategoryName")
Case "TOTAL"
Select Case FoundRow("Description")
Case "BOOK", "BOOK SALES", "GC"
BookSales(i) = BookSales(i) + (FoundRow("netAmt"))
End Select
End Select
Next
MsgBox(LocationName & BookSales(i))
MsgBox(LocationName & BookSales(0))
MsgBox(LocationName & BookSales(1))
Catch ex As Exception
MsgBox(ex.Message)
Finally
If connection IsNot Nothing Then
connection.Dispose()
End If
End Try
End If
End Sub
Public Sub GetLocation()
Select Case locationcounter
Case "1"
LocationName = "Location1"
LocationDB = "10.0.1.52"
Case "2"
LocationName = "Location2"
LocationDB = "10.0.1.51"
Case "3"
LocationName = "Location3"
LocationDB = "10.0.1.50"
End Select
End Sub

Resources