treeview disappeared when i reopen the form - vb.net

I would like to ask for your help. I am stuck to this for more than two days, I've searched the net but unfortunately got no answer.
I have a program in vb 2008 and a database (SQL Server 2008). I have this form which contains treeview. The items display is selected from the database. When i run the program and open the form the treeview items displayed (at first), but when i closed the form and try to open it again the treeview disappear. I dont know why :( . Why is it disappearing? Can somebody help me please. Thank you.
Below is my code....
#form_load
Private Sub frmProfile_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Call conecDB()
Call initCMD()
FillTable()
CreateTree() 'create the treeview node
findNode() 'find and checked the selected nodes that was given to the profile
End Sub
'the functions
Private Sub FillTable()
'tv1.Nodes.Clear()
dtable.Columns.Add("ID", GetType(Integer))
dtable.Columns.Add("NAME", GetType(String))
dtable.Columns.Add("PARENT", GetType(Integer))
dtable.Columns.Add("LEVEL", GetType(Integer))
qSQL = "select mod_id,name,parent,level,sort,mnu_name from module where status='A' and parent!=-1"
With comDB
.CommandText = qSQL
rdDB = .ExecuteReader
End With
Do While rdDB.Read
dtable.Rows.Add(rdDB!mod_id, rdDB!name.ToString(), rdDB!parent)
My.Application.DoEvents()
Loop
For i = 0 To dtable.Rows.Count - 1
Dim ID1 As String = dtable.Rows(i).Item("ID").ToString
dtable.Rows(i).Item("LEVEL") = FindLevel(ID1, 0)
Next
rdDB.Close()
End Sub
Private Function FindLevel(ByVal ID As String, ByRef Level As Integer) As Integer
For i = 0 To dtable.Rows.Count - 1
Dim ID1 As String = dtable.Rows(i).Item("ID").ToString
Dim Parent1 As String = dtable.Rows(i).Item("PARENT").ToString
If ID = ID1 Then
If Parent1 = 0 Then
Return Level
Else
Level += 1
FindLevel(Parent1, Level)
End If
End If
Next
Return Level
End Function
Private Sub CreateTree()
tv1.Nodes.Clear()
Dim MaxLevel1 As Integer = CInt(dtable.Compute("MAX(LEVEL)", ""))
Dim i, j As Integer
For i = 0 To MaxLevel1
Dim Rows1() As DataRow = dtable.Select("LEVEL = " & i)
For j = 0 To Rows1.Count - 1
Dim ID1 As String = Rows1(j).Item("ID").ToString
Dim Name1 As String = Rows1(j).Item("NAME").ToString
'Dim mName As String = Rows1(j).Item("mNAME").ToString
Dim Parent1 As String = Rows1(j).Item("PARENT").ToString
If Parent1 = 0 Then
tv1.Nodes.Add(ID1, Name1)
Else
Dim TreeNodes1() As TreeNode = tv1.Nodes.Find(Parent1, True)
If TreeNodes1.Length > 0 Then
TreeNodes1(0).Nodes.Add(ID1, Name1)
End If
End If
Next
Next
End Sub
Private Sub findNode()
Dim rName As String = String.Empty
Dim b As Boolean = True
qSQL = "select access_id,mnu_name from profile_details where prof_id=" & lblPID.Text & ""
With comDB
.CommandText = qSQL
rdDB = .ExecuteReader
End With
Do While rdDB.Read
rName = rdDB!access_id.ToString()
Try
Dim arr As TreeNode() = tv1.Nodes.Find(rName, b)
For i = 0 To arr.Length - 1
tv1.SelectedNode = arr(i)
tv1.SelectedNode.Checked = True
Next
Catch
MsgBox(Err)
End Try
Loop
rdDB.Close()
End Sub

Related

Find and highlight the max value in from multiple column in VB.net

Hi i need anyone to help me,
I need to highlight the highest value from multiple column in table
For Ex:-
I have try out some coding..
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
UIUtility = New UIUtility()
Dim dtStartProcessTime As DateTime
Dim dtEndProcessTime As DateTime
Dim dtStartQueryTime As DateTime
Dim dtEndQueryTime As DateTime
Dim tsQueryTime As TimeSpan
Dim tsProcessTime As TimeSpan
Dim strCassList As String = ""
Dim dtDefectInfo As New DataTable
Dim dtDefectList As New DataTable
Dim dtResult As New DataTable
Dim dtSelectDefectInfo As New DataTable
Dim strCass_id As String = ""
Dim dtDisplay As New DataTable
Try
dtStartProcessTime = Now
Me.Title = "Shipping Cassettes List"
Dim sEvent_date As String = Request.QueryString("Event_date").Trim()
Dim sRecipe As String = Request.QueryString("recipe").Trim()
Dim sOperation As String = Request.QueryString("operation").Trim()
Dim sEquipment As String = Request.QueryString("equipment").Trim()
lblStatus.Text = "Event_date:" + sEvent_date + _
"<br>Recipe:" + sRecipe + _
"<br>Operation:" + sOperation + _
"<br>Equipment:" + sEquipment + _
"<br><br>"
Dim dtCass As DataTable
Dim drNew As DataRow
Dim SelectDefectInfo As DataRow()
dtStartQueryTime = Now
dtCass = UIUtility.RetrieveShipCassette(sEvent_date, sRecipe, sOperation, sEquipment)
If dtCass.Rows.Count > 0 Then
strCassList = UIUtility.ReturnStringFromdt(dtCass, "shipping_cass_id")
dtDefectInfo = UIUtility.RetrieveDefectInfo(strCassList)
dtDefectList = UIUtility.dtView(dtDefectInfo, "defect")
dtResult.Columns.Add("cass_id", Type.GetType("System.String"))
For i = 0 To dtDefectList.Rows.Count - 1
If Not (dtDefectList.Rows(i).Item("defect").ToString().Equals("NON")) Then
dtResult.Columns.Add(dtDefectList.Rows(i).Item("defect"), Type.GetType("System.Int32")).DefaultValue = 0
End If
Next
For i = 0 To dtCass.Rows.Count - 1
drNew = dtResult.NewRow
strCass_id = dtCass.Rows(i).Item("shipping_cass_id")
drNew("cass_id") = dtCass.Rows(i).Item("cass_id")
SelectDefectInfo = dtDefectInfo.Select("dest_cass_id = '" + strCass_id + "'")
dtSelectDefectInfo = New DataTable
If SelectDefectInfo.Count > 0 Then
dtSelectDefectInfo = SelectDefectInfo.CopyToDataTable
For j = 0 To dtSelectDefectInfo.Rows.Count - 1
If Not (dtSelectDefectInfo.Rows(j).Item("defect").ToString().Trim().Equals("NON")) Then
drNew(dtSelectDefectInfo.Rows(j).Item("defect").ToString()) = dtSelectDefectInfo.Rows(j).Item("defect_count").ToString()
End If
Next
End If
dtResult.Rows.Add(drNew)
Next
End If
dtEndQueryTime = Now
tsQueryTime = dtEndQueryTime.Subtract(dtStartQueryTime)
'For i As Integer = 0 To dtCass.Rows.Count - 1
' drDisplay = dtDisplay.NewRow
' drDisplay("cass_id") = dtCass.Rows(i)("cass_id").ToString()
' dtDisplay.Rows.Add(drDisplay)
' 'dtCass.Rows(i).Item(
'Next
'e.Row.BorderWidth = 2
dgSummary.DataSource = Nothing
dgSummary.DataSource = dtResult
dgSummary.DataBind()
lblStatus.Text += "Total " + dtResult.Rows.Count.ToString + " rows of data found."
dtEndProcessTime = Now
tsProcessTime = dtEndProcessTime.Subtract(dtStartProcessTime)
lblProcessingTime.Text = "Processing Time: " + tsProcessTime.TotalSeconds.ToString + " Secs (Query Time: " + tsQueryTime.TotalSeconds.ToString + " Secs)"
For Each r As GridViewRow In dtResult.Rows()
Dim max As Integer = Integer.MinValue
For i = 1 To r.Cells.Count - 1
Dim n As Integer
If Integer.TryParse(CType(r.Cells(i).Text, String), n) Then max = Math.Max(n, max)
Next
For i = 1 To r.Cells.Count - 1
If r.Cells(i).Text = max Then
r.Cells(i).BackColor = Drawing.Color.Orange
Exit For
End If
Next
Next
Catch ex As Exception
lblMessage.Text = "An error occured:" + ex.Message + " Please contact your administrator."
MyLog.WriteToLog(Me.GetType().Name(), System.Reflection.MethodInfo.GetCurrentMethod().Name, "Exception occured." & vbCrLf & "Error Message:" & ex.Message & vbCrLf & " StackTrace:" & ex.StackTrace)
End Try
End Sub
Protected Sub dgSummary_RowDataBound(ByVal sender As Object, ByVal e As System.Web.UI.WebControls.GridViewRowEventArgs) Handles dgSummary.RowDataBound
Dim cass_id As String = ""
'Dim dtResult As New DataTable
'Dim DataGridView1 As New DataTable
Dim dtCass As New DataTable
If e.Row.RowType = DataControlRowType.DataRow Then
cass_id = e.Row.Cells(0).Text.Trim
If Not e.Row.Cells(0).Text.Trim.Equals("") Then
e.Row.Cells(0).Attributes.Add("Title", "Click and view the cassette details")
e.Row.Cells(0).Attributes("onmouseover") = "this.style.color='DodgerBlue';this.style.cursor='hand';"
e.Row.Cells(0).Attributes("onmouseout") = "this.style.color='Black';"
e.Row.Cells(0).Attributes("onClick") = _
String.Format("window.open('{0}','_blank','scrollbars=yes,status=yes,location=yes,toolbar=yes,menubar=yes,resizable=Yes')", _
ResolveUrl(System.Configuration.ConfigurationManager.AppSettings("SFEHReportLink_SSL") + cass_id))
e.Row.Cells(0).Style("cursor") = "pointer"
End If
End Sub
Maybe theres any coding that more easier than this since i have 17items
Thank you so much for you guys help.
After i add the new code, i got this error,
new error
maybe this example can help you
Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
For Each r As DataGridViewRow In DataGridView1.Rows
Dim max As Integer = Integer.MinValue
For i = 1 To r.Cells.Count - 1
Dim n As Integer
If Integer.TryParse(CType(r.Cells(i).Value, String), n) Then max = Math.Max(n, max)
Next
For i = 1 To r.Cells.Count - 1
If r.Cells(i).Value = max Then
r.Cells(i).Style.BackColor = Color.Orange
Exit For
End If
Next
Next
End Sub

vb.net threading sub slower than call sub

I know this Question was already posted, but it was never really answered, or I did not understand the answer :)
My Problem is that when I call this Sub within the Thread, it takes about 4 sec to execute the code, but if I make a simple Call Sub (Like commented in Code) it takes about 450 ms.
I have a simple program with 2 Subs:
To report Progress on Main Form
To do some "For" Looping
Imports System.Data.SqlClient
Public Class Form1
Public Delegate Sub ProzentDelegate(ByVal Prozent As Double)
Dim G_I_Temp As Integer = 0
Dim G_S_Prüfziffer As String
Dim G_S_Präfix As String
Dim G_I_Zähler As Integer
Dim G_I_Stellen As Integer
Dim G_D_Step As Integer = 1
Dim G_I_Position As Integer
Dim DT_G_Prüftabelle As DataTable
Dim DR_G_Prüftabelle As DataRow
Dim thisLock As New Object
Dim conn As String = "Data Source=SR-SQLWVS;Initial Catalog=Barcode;Integrated Security=True"
Dim sourceconn As New SqlConnection(conn)
Dim adap As SqlDataAdapter
Dim cmd As SqlCommand = New SqlCommand("SELECT TOP(10) * FROM dbo.Prüf_Tabelle", sourceconn)
Dim Thrd_preview As Threading.Thread
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
sourceconn.Open()
cmd.Connection = sourceconn
End Sub
Public Sub ReportProgress(ByVal Prozent As Double)
ProgressBar1.Value = Prozent
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
If RB_Thread.Checked Then
If Thrd_preview IsNot Nothing Then Thrd_preview = Nothing
Thrd_preview = New Threading.Thread(AddressOf DoSomeWork)
Thrd_preview.IsBackground = True
Thrd_preview.Start()
Else
DoSomeWork()
End If
End Sub
Private Sub DoSomeWork()
Dim ds As New DataSet
DT_G_Prüftabelle = ds.Tables.Add("Prüf_Tabelle")
Dim L_I_Counter, L_I_Counter2 As Integer
Dim L_I_Ende As Integer
Dim L_I_Step As Integer
Dim L_I_Nutzen As Integer = 1
L_I_Step = 1
L_I_Ende = Val(TB_Auftrag_neu_Anzahl.Text)
G_I_Stellen = 8
G_S_Prüfziffer = "1"
G_S_Präfix = "00"
If TB_Info_Increment.Text = "" Then TB_Info_Increment.Text = 1
adap = New SqlDataAdapter("SELECT TOP(10) * FROM dbo.Prüf_Tabelle", sourceconn)
adap.FillSchema(DT_G_Prüftabelle, SchemaType.Mapped)
DT_G_Prüftabelle.Rows.Clear()
Dim pre As Date = Now
For L_I_Counter = 1 To (L_I_Ende * L_I_Step) Step L_I_Step
For L_I_Counter2 = 1 To L_I_Nutzen
DR_G_Prüftabelle = DT_G_Prüftabelle.NewRow
DR_G_Prüftabelle.Item("Auftrag_Lfd_nr") = TB_KeyLot.Text
DR_G_Prüftabelle.Item("Position") = G_I_Position
G_I_Position += G_D_Step
DR_G_Prüftabelle.Item("Barcode_soll") = F_Berechnung((Trim(Str(Val(TB_Auftrag_neu_Von.Text) + L_I_Counter - 1))).PadLeft(G_I_Stellen, "0"))
DT_G_Prüftabelle.Rows.Add(DR_G_Prüftabelle)
If ProgressBar1.InvokeRequired Then
ProgressBar1.BeginInvoke(New ProzentDelegate(AddressOf ReportProgress), (L_I_Counter * 100) / (L_I_Ende * L_I_Step))
Else
ReportProgress((L_I_Counter * 100) / (L_I_Ende * L_I_Step))
End If
Next
Next
MsgBox(Now.Subtract(pre).TotalMilliseconds.ToString & " ms.")
End Sub
Function F_Berechnung(ByVal L_Nummer As String) As String
Dim L_B_Gerade As Boolean = False
Dim L_I_Prüfziffer As Integer
Dim L_I_Stellen As Integer
Me.G_I_Temp = 0
Select Case G_S_Prüfziffer
Case "0"
F_Berechnung = L_Nummer
Case "1"
F_Berechnung = G_S_Präfix & Trim(L_Nummer)
Case "2"
F_Berechnung = G_S_Präfix & Trim(L_Nummer)
Case "3"
F_Berechnung = L_Nummer
'
Case "5" '-----Mod 10 gewichtung 31...-----
L_Nummer = G_S_Präfix & Trim(L_Nummer)
L_I_Stellen = Len(L_Nummer)
For Me.G_I_Zähler = L_I_Stellen To 1 Step -1
Me.G_I_Temp += Val(Mid(L_Nummer, Me.G_I_Zähler, 1)) * IIf(L_B_Gerade, 1, 3)
L_B_Gerade = Not L_B_Gerade
Next
L_I_Prüfziffer = IIf(10 - Me.G_I_Temp Mod 10 = 10, 0, 10 - Me.G_I_Temp Mod 10)
F_Berechnung = Trim(L_Nummer) & Trim(Str(L_I_Prüfziffer))
'
Case "6" '-----Mod 10 gewichtung 13...-----
L_Nummer = G_S_Präfix & Trim(L_Nummer)
L_I_Stellen = Len(L_Nummer)
For Me.G_I_Zähler = L_I_Stellen To 1 Step -1
Me.G_I_Temp += Val(Mid(L_Nummer, Me.G_I_Zähler, 1)) * IIf(L_B_Gerade, 3, 1)
L_B_Gerade = Not L_B_Gerade
Next
L_I_Prüfziffer = IIf(10 - Me.G_I_Temp Mod 10 = 10, 0, 10 - Me.G_I_Temp Mod 10)
F_Berechnung = Trim(L_Nummer) & Trim(Str(L_I_Prüfziffer))
'
Case Else
F_Berechnung = L_Nummer
End Select
End Function
I have tried to take out Progress Reporting but the Result is the same.
I hope you have some suggestions or solutions for me. I would be very thankful.
Give these changes a try
Change this
If ProgressBar1.InvokeRequired Then
ProgressBar1.Invoke(New ProzentDelegate(AddressOf ReportProgress), Progr)
Else
ReportProgress(Progr)
End If
to
ReportProgress(Progr)
And change method ReportProgress to
Public Sub ReportProgress(ByVal Prozent As Double)
Me.BeginInvoke(Sub()
ProgressBar1.Value = Prozent
End Sub)
End Sub
See if that makes a difference. The check for InvokeRequired is not needed, the answer is always yes.
Just wanted to report that I found a solution.
The main problem was this line of code in:
DR_G_Prüftabelle.Item("Auftrag_Lfd_nr") = TB_KeyLot.Text
So if I start this Sub from another Thread rather than from a Main Thread, for every single loop it has to go to main thread and to take Paramater from TextBox and to go back in Thread to Loop further.
I took that out, declared a variable at the begining and assigned this TextBox value to it and it works like charm.
Also I took a suggestion from dbasnett to Invoke Reporting every time without If-Else and also the suggestion from Steven Doggart to Report every 100 Loops.
You guys helped a lot. Thanks for that!!

Reading and writing from a csv file

Structure TownType
Dim Name As String
Dim County As String
Dim Population As Integer
Dim Area As Integer
End Structure
Sub Main()
Dim TownList As TownType
Dim FileName As String
Dim NumberOfRecords As Integer
FileName = "N:\2_7_towns(2).csv"
FileOpen(1, FileName, OpenMode.Random, , , Len(TownList))
NumberOfRecords = LOF(1) / Len(TownList)
Console.WriteLine(NumberOfRecords)
Console.ReadLine()
There are only 12 records in the file but this returns a value of 24 for number of records. How do I fix this?
Contents of csv file:
Town, County,Pop, Area
Berwick-upon-tweed, Nothumberland,12870,468
Bideford, devon,16262,430
Bognor Regis, West Sussex,62141,1635
Bridlington, East Yorkshire,33589,791
Bridport, Dorset,12977,425
Cleethorpes, Lincolnshire,31853,558
Colwyn bay, Conway,30269,953
Dover, Kent,34087,861
Falmouth, Cornwall,21635,543
Great Yarmouth, Norfolk,58032,1467
Hastings, East Sussex,85828,1998
This will read the contents into a collection and you can get the number of records from the collection.
Sub Main()
Dim FileName As String
Dim NumberOfRecords As Integer
FileName = "N:\2_7_towns(2).csv"
'read the lines into an array
Dim lines As String() = System.IO.File.ReadAllLines(FileName)
'read the array into a collection of town types
'this could also be done i a loop if you need better
'parsing or error handling
Dim TownList = From line In lines _
Let data = line.Split(",") _
Select New With {.Name = data(0), _
.County = data(1), _
.Population = data(2), _
.Area = data(3)}
NumberOfRecords = TownList.Count
Console.WriteLine(NumberOfRecords)
Console.ReadLine()
End Sub
Writing to the console would be accomplished with something like:
For Each town In TownList
Console.WriteLine(town.Name + "," + town.County)
Next
Many ways to do that
Test this:
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
dim FileName as string = "N:\2_7_towns(2).csv"
Dim Str() As String = System.IO.File.ReadAllLines(filename)
'Str(0) contains : "Town, County,Pop, Area"
'Str(1) contains : "Berwick-upon-tweed, Nothumberland,12870,468"
'Str(2) contains : "Bideford, devon,16262,430"
' etc...
'Sample code for string searching :
Dim Lst As New List(Of String)
Lst.Add(Str(0))
Dim LookingFor As String = "th"
For Each Line As String In Str
If Line.Contains(LookingFor) Then Lst.Add(Line)
Next
Dim Result As String = ""
For Each St As String In Lst
Result &= St & Environment.NewLine
Next
MessageBox.Show(Result)
'Sample code creating a grid :
Dim Grid = New DataGridView
Me.Controls.Add(Grid)
Grid.ColumnCount = Str(0).Split(","c).GetUpperBound(0) + 1
Grid.RowCount = Lst.Count - 1
Grid.RowHeadersVisible = False
For r As Integer = 0 To Lst.Count - 1
If r = 0 Then
For i As Integer = 0 To Lst(r).Split(","c).GetUpperBound(0)
Grid.Columns(i).HeaderCell.Value = Lst(0).Split(","c)(i)
Next
Else
For i As Integer = 0 To Lst(r).Split(","c).GetUpperBound(0)
Grid(i, r - 1).Value = Lst(r).Split(","c)(i)
Next
End If
Next
Grid.AutoResizeColumns()
Grid.AutoSize = True
End Sub

vb.net - Why do I get this error when trying to bubble sort a csv file?

I have a csv file which I'm trying to sort by data (numerical form)
The csv file:
date, name, phone number, instructor name
1308290930,jim,041231232,sushi
123123423,jeremy,12312312,albert
The error I get is: Conversion from string "jeremy" to type 'double'is not valid
Even though no where in my code I mention double...
My code:
Public Class Form2
Dim currentRow As String()
Dim count As Integer
Dim one As Integer
Dim two As Integer
Dim three As Integer
Dim four As Integer
'concatenation / and operator
'casting
Dim catchit(100) As String
Dim count2 As Integer
Dim arrayone(4) As Decimal
Dim arraytwo(4) As String
Dim arraythree(4) As Decimal
Dim arrayfour(4) As String
Dim array(4) As String
Dim bigstring As String
Dim builder As Integer
Dim twodata As Integer
Private Sub Form2_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Using MyReader As New Microsoft.VisualBasic.FileIO.TextFieldParser("D:\completerecord.txt")
MyReader.TextFieldType = FileIO.FieldType.Delimited
MyReader.SetDelimiters(",")
Dim currentRow As String()
Dim count As Integer
Dim currentField As String
count = 0
While Not MyReader.EndOfData
Try
currentRow = MyReader.ReadFields()
For Each currentField In currentRow
' makes one array to contain a record for each peice of text in the file
'MsgBox(currentField) '- test of Field Data
' builds a big string with new line-breaks for each line in the file
bigstring = bigstring & currentField + Environment.NewLine
'build two arrays for the two columns of data
If (count Mod 2 = 1) Then
arraytwo(two) = currentField
two = two + 1
'MsgBox(currentField)
ElseIf (count Mod 2 = 0) Then
arrayone(one) = currentField
one = one + 1
ElseIf (count Mod 2 = 2) Then
arraythree(three) = currentField
three = three + 1
ElseIf (count Mod 2 = 3) Then
arrayfour(four) = currentField
four = four + 1
End If
count = count + 1
'MsgBox(count)
Next
Catch ex As Microsoft.VisualBasic.FileIO.MalformedLineException
MsgBox("Error Occured, Please contact Admin.")
End Try
End While
End Using
RichTextBox1.Text = bigstring
' MsgBox("test")
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim NoMoreSwaps As Boolean
Dim counter As Integer
Dim Temp As Integer
Dim Temp2 As String
Dim listcount As Integer
Dim builder As Integer
Dim bigString2 As String = ""
listcount = UBound(arraytwo)
'MsgBox(listcount)
builder = 0
'bigString2 = ""
counter = 0
Try
'this should sort the arrays using a Bubble Sort
Do Until NoMoreSwaps = True
NoMoreSwaps = True
For counter = 0 To (listcount - 1)
If arraytwo(counter) > arraytwo(counter + 1) Then
NoMoreSwaps = False
If arraytwo(counter + 1) > 0 Then
Temp = arraytwo(counter)
Temp2 = arrayone(counter)
arraytwo(counter) = arraytwo(counter + 1)
arrayone(counter) = arrayone(counter + 1)
arraytwo(counter + 1) = Temp
arrayone(counter + 1) = Temp2
End If
End If
Next
If listcount > -1 Then
listcount = listcount - 1
End If
Loop
'now we need to output arrays to the richtextbox first we will build a new string
'and we can save it to a new sorted file
Dim FILE_NAME As String = "D:\sorted.txt"
'Location of file^ that the new data will be saved to
If System.IO.File.Exists(FILE_NAME) = True Then
Dim objWriter As New System.IO.StreamWriter(FILE_NAME, True)
'If D:\sorted.txt exists then enable it to be written to
While builder < listcount
bigString2 = bigString2 & arraytwo(builder) & "," & arrayone(builder) + Environment.NewLine
objWriter.Write(arraytwo(builder) & "," & arrayone(builder) + Environment.NewLine)
builder = builder + 1
End While
RichTextBox2.Text = bigString2
objWriter.Close()
MsgBox("Text written to log file")
Else
MsgBox("File Does Not Exist")
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
End Class
I think in this line is the problem
arrayone(one) = currentField
Here it trys to cast the string to a double. You have to use something like this:
arrayone(one) = Double.Parse(currentField)
or to have it a saver way:
Dim dbl As Double
If Double.TryParse(currentField, dbl) Then
arrayone(one) = dbl
Else
arrayone(one) = 0.0
End If

How to export datagridview to excel using vb.net?

I have a datagridview in vb.net that is filled up from the database. I've researched and I found out that there is no built in support to print directly from datagridview. I don't want to use crystal report because I'm not familiar with it.
I'm planning to export it to excel to enable me to generate report from the datagridview.
Can you provide me ways to do this?
Code below creates Excel File and saves it in D: drive
It uses Microsoft office 2007
FIRST ADD REFERRANCE (Microsoft office 12.0 object library ) to your project
Then Add code given bellow to the Export button click event-
Private Sub Export_Button_Click(ByVal sender As System.Object, ByVal e As
System.EventArgs) Handles VIEW_Button.Click
Dim xlApp As Microsoft.Office.Interop.Excel.Application
Dim xlWorkBook As Microsoft.Office.Interop.Excel.Workbook
Dim xlWorkSheet As Microsoft.Office.Interop.Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
Dim i As Integer
Dim j As Integer
xlApp = New Microsoft.Office.Interop.Excel.ApplicationClass
xlWorkBook = xlApp.Workbooks.Add(misValue)
xlWorkSheet = xlWorkBook.Sheets("sheet1")
For i = 0 To DataGridView1.RowCount - 2
For j = 0 To DataGridView1.ColumnCount - 1
For k As Integer = 1 To DataGridView1.Columns.Count
xlWorkSheet.Cells(1, k) = DataGridView1.Columns(k - 1).HeaderText
xlWorkSheet.Cells(i + 2, j + 1) = DataGridView1(j, i).Value.ToString()
Next
Next
Next
xlWorkSheet.SaveAs("D:\vbexcel.xlsx")
xlWorkBook.Close()
xlApp.Quit()
releaseObject(xlApp)
releaseObject(xlWorkBook)
releaseObject(xlWorkSheet)
MsgBox("You can find the file D:\vbexcel.xlsx")
End Sub
Private Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
Excel Method
This method is different than many you will see. Others use a loop to write each cell and write the cells with text data type.
This method creates an object array from a DataTable or DataGridView and then writes the array to Excel. This means I can write to Excel without a loop and retain data types.
I extracted this from my library and I think I changed it enough to work with this code only, but more minor tweaking might be necessary. If you get errors just let me know and I'll correct them for you. Normally, I create an instance of my class and call these methods. If you would like to use my library then use this link to download it and if you need help just let me know.
https://zomp.co/Files.aspx?ID=zExcel
After copying the code to your solution you will use it like this.
In your button code add this and change the names to your controls.
WriteDataGrid("Sheet1", grid)
To open your file after exporting use this line
System.Diagnostics.Process.Start("The location and filename of your file")
In the WriteArray method you'll want to change the line that saves the workbook to where you want to save it. Probably makes sense to add this as a parameter.
wb.SaveAs("C:\MyWorkbook.xlsx")
Public Function WriteArray(Sheet As String, ByRef ObjectArray As Object(,)) As String
Try
Dim xl As Excel.Application = New Excel.Application
Dim wb As Excel.Workbook = xl.Workbooks.Add()
Dim ws As Excel.Worksheet = wb.Worksheets.Add()
ws.Name = Sheet
Dim range As Excel.Range = ws.Range("A1").Resize(ObjectArray.GetLength(0), ObjectArray.GetLength(1))
range.Value = ObjectArray
range = ws.Range("A1").Resize(1, ObjectArray.GetLength(1) - 1)
range.Interior.Color = RGB(0, 70, 132) 'Con-way Blue
range.Font.Color = RGB(Drawing.Color.White.R, Drawing.Color.White.G, Drawing.Color.White.B)
range.Font.Bold = True
range.WrapText = True
range.HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter
range.VerticalAlignment = Excel.XlVAlign.xlVAlignCenter
range.Application.ActiveWindow.SplitColumn = 0
range.Application.ActiveWindow.SplitRow = 1
range.Application.ActiveWindow.FreezePanes = True
wb.SaveAs("C:\MyWorkbook.xlsx")
wb.CLose()
xl.Quit()
xl = Nothing
wb = Nothing
ws = Nothing
range = Nothing
ReleaseComObject(xl)
ReleaseComObject(wb)
ReleaseComObject(ws)
ReleaseComObject(range)
Return ""
Catch ex As Exception
Return "WriteArray()" & Environment.NewLine & Environment.NewLine & ex.Message
End Try
End Function
Public Function WriteDataGrid(SheetName As String, ByRef dt As DataGridView) As String
Try
Dim l(dt.Rows.Count + 1, dt.Columns.Count) As Object
For c As Integer = 0 To dt.Columns.Count - 1
l(0, c) = dt.Columns(c).HeaderText
Next
For r As Integer = 1 To dt.Rows.Count
For c As Integer = 0 To dt.Columns.Count - 1
l(r, c) = dt.Rows(r - 1).Cells(c)
Next
Next
Dim errors As String = WriteArray(SheetName, l)
If errors <> "" Then
Return errors
End If
Return ""
Catch ex As Exception
Return "WriteDataGrid()" & Environment.NewLine & Environment.NewLine & ex.Message
End Try
End Function
Public Function WriteDataTable(SheetName As String, ByRef dt As DataTable) As String
Try
Dim l(dt.Rows.Count + 1, dt.Columns.Count) As Object
For c As Integer = 0 To dt.Columns.Count - 1
l(0, c) = dt.Columns(c).ColumnName
Next
For r As Integer = 1 To dt.Rows.Count
For c As Integer = 0 To dt.Columns.Count - 1
l(r, c) = dt.Rows(r - 1).Item(c)
Next
Next
Dim errors As String = WriteArray(SheetName, l)
If errors <> "" Then
Return errors
End If
Return ""
Catch ex As Exception
Return "WriteDataTable()" & Environment.NewLine & Environment.NewLine & ex.Message
End Try
End Function
I actually don't use this method in my Database program because it's a slow method when you have a lot of rows/columns. I instead create a CSV from the DataGridView. Writing to Excel with Excel Automation is only useful if you need to format the data and cells otherwise you should use CSV. You can use the code after the image for CSV export.
CSV Method
Private Sub DataGridToCSV(ByRef dt As DataGridView, Qualifier As String)
Dim TempDirectory As String = "A temp Directory"
System.IO.Directory.CreateDirectory(TempDirectory)
Dim oWrite As System.IO.StreamWriter
Dim file As String = System.IO.Path.GetRandomFileName & ".csv"
oWrite = IO.File.CreateText(TempDirectory & "\" & file)
Dim CSV As StringBuilder = New StringBuilder()
Dim i As Integer = 1
Dim CSVHeader As StringBuilder = New StringBuilder()
For Each c As DataGridViewColumn In dt.Columns
If i = 1 Then
CSVHeader.Append(Qualifier & c.HeaderText.ToString() & Qualifier)
Else
CSVHeader.Append("," & Qualifier & c.HeaderText.ToString() & Qualifier)
End If
i += 1
Next
'CSV.AppendLine(CSVHeader.ToString())
oWrite.WriteLine(CSVHeader.ToString())
oWrite.Flush()
For r As Integer = 0 To dt.Rows.Count - 1
Dim CSVLine As StringBuilder = New StringBuilder()
Dim s As String = ""
For c As Integer = 0 To dt.Columns.Count - 1
If c = 0 Then
'CSVLine.Append(Qualifier & gridResults.Rows(r).Cells(c).Value.ToString() & Qualifier)
s = s & Qualifier & gridResults.Rows(r).Cells(c).Value.ToString() & Qualifier
Else
'CSVLine.Append("," & Qualifier & gridResults.Rows(r).Cells(c).Value.ToString() & Qualifier)
s = s & "," & Qualifier & gridResults.Rows(r).Cells(c).Value.ToString() & Qualifier
End If
Next
oWrite.WriteLine(s)
oWrite.Flush()
'CSV.AppendLine(CSVLine.ToString())
'CSVLine.Clear()
Next
'oWrite.Write(CSV.ToString())
oWrite.Close()
oWrite = Nothing
System.Diagnostics.Process.Start(TempDirectory & "\" & file)
GC.Collect()
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
DATAGRIDVIEW_TO_EXCEL((DataGridView1)) ' PARAMETER: YOUR DATAGRIDVIEW
End Sub
Private Sub DATAGRIDVIEW_TO_EXCEL(ByVal DGV As DataGridView)
Try
Dim DTB = New DataTable, RWS As Integer, CLS As Integer
For CLS = 0 To DGV.ColumnCount - 1 ' COLUMNS OF DTB
DTB.Columns.Add(DGV.Columns(CLS).Name.ToString)
Next
Dim DRW As DataRow
For RWS = 0 To DGV.Rows.Count - 1 ' FILL DTB WITH DATAGRIDVIEW
DRW = DTB.NewRow
For CLS = 0 To DGV.ColumnCount - 1
Try
DRW(DTB.Columns(CLS).ColumnName.ToString) = DGV.Rows(RWS).Cells(CLS).Value.ToString
Catch ex As Exception
End Try
Next
DTB.Rows.Add(DRW)
Next
DTB.AcceptChanges()
Dim DST As New DataSet
DST.Tables.Add(DTB)
Dim FLE As String = "" ' PATH AND FILE NAME WHERE THE XML WIL BE CREATED (EXEMPLE: C:\REPS\XML.xml)
DTB.WriteXml(FLE)
Dim EXL As String = "" ' PATH OF/ EXCEL.EXE IN YOUR MICROSOFT OFFICE
Shell(Chr(34) & EXL & Chr(34) & " " & Chr(34) & FLE & Chr(34), vbNormalFocus) ' OPEN XML WITH EXCEL
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub
Regarding your need to 'print directly from datagridview', check out this article on CodeProject:
The DataGridViewPrinter Class
There are a number of similar articles but I've had luck with the one I linked.
The following code works fine for me :)
Protected Sub ExportToExcel(sender As Object, e As EventArgs) Handles ExportExcel.Click
Try
Response.Clear()
Response.Buffer = True
Response.AddHeader("content-disposition", "attachment;filename=ExportEthias.xls")
Response.Charset = ""
Response.ContentType = "application/vnd.ms-excel"
Using sw As New StringWriter()
Dim hw As New HtmlTextWriter(sw)
GvActifs.RenderControl(hw)
'Le format de base est le texte pour éviter les problèmes d'arrondis des nombres
Dim style As String = "<style> .textmode { } </style>"
Response.Write(Style)
Response.Output.Write(sw.ToString())
Response.Flush()
Response.End()
End Using
Catch ex As Exception
lblMessage.Text = "Erreur export Excel : " & ex.Message
End Try
End Sub
Public Overrides Sub VerifyRenderingInServerForm(control As Control)
' Verifies that the control is rendered
End Sub
Hopes this help you.
Dim rowNo1 As Short
Dim numrow As Short
Dim colNo1 As Short
Dim colNo2 As Short
rowNo1 = 1
colNo1 = 1
colNo2 = 1
numrow = 1
ObjEXCEL = CType(CreateObject("Excel.Application"), Microsoft.Office.Interop.Excel.Application)
objEXCELBook = CType(ObjEXCEL.Workbooks.Add, Microsoft.Office.Interop.Excel.Workbook)
objEXCELSheet = CType(objEXCELBook.Worksheets(1), Microsoft.Office.Interop.Excel.Worksheet)
ObjEXCEL.Visible = True
For numCounter = 0 To grdName.Columns.Count - 1
' MsgBox(grdName.Columns(numCounter).HeaderText())
If grdName.Columns(numCounter).Width > 0 Then
ObjEXCEL.Cells(1, numCounter + 1) = grdName.Columns(numCounter).HeaderText()
End If
' ObjEXCEL.Cells(1, numCounter + 1) = grdName.Columns.GetFirstColumn(DataGridViewElementStates.Displayed)
Next numCounter
ObjEXCEL.Range("A:A").ColumnWidth = 10
ObjEXCEL.Range("B:B").ColumnWidth = 25
ObjEXCEL.Range("C:C").ColumnWidth = 20
ObjEXCEL.Range("D:D").ColumnWidth = 20
ObjEXCEL.Range("E:E").ColumnWidth = 20
ObjEXCEL.Range("F:F").ColumnWidth = 25
For rowNo1 = 0 To grdName.RowCount - 1
For colNo1 = 0 To grdName.ColumnCount - 1
If grdName.Columns(colNo1).Width > 0 Then
If Trim(grdName.Item(colNo1, rowNo1).Value) <> "" Then
'If IsDate(grdName.Item(colNo1, rowNo1).Value) = True Then
' ObjEXCEL.Cells(numrow + 1, colNo2) = Format(CDate(grdName.Item(colNo1, rowNo1).Value), "dd/MMM/yyyy")
'Else
ObjEXCEL.Cells(numrow + 1, colNo2) = grdName.Item(colNo1, rowNo1).Value
'End If
End If
If colNo2 >= grdName.ColumnCount Then
colNo2 = 1
Else
colNo2 = colNo2 + 1
End If
End If
Next colNo1
numrow = numrow + 1
Next rowNo1
In design mode: Set DataGridView1 ClipboardCopyMode properties to EnableAlwaysIncludeHeaderText
or on the program code
DataGridView1.ClipboardCopyMode = DataGridViewClipboardCopyMode.EnableAlwaysIncludeHeaderText
In the run time select all cells content (Ctrl+A) and copy (Ctrl+C) and paste to the Excel Program.
Let the Excel do the rest
Sorry for the inconvenient, I have been searching the method to print data directly from the datagridvew (create report from vb.net VB2012) and have not found the satisfaction result.
Above code just my though, wondering if my applications user can rely on above simple step it will be nice and I could go ahead to next step on my program progress.
A simple way of generating a printable report from a Datagridview is to place the datagridview on a Panel object. It is possible to draw a bitmap of the panel.
Here's how I do it.
'create the bitmap with the dimentions of the Panel
Dim bmp As New Bitmap(Panel1.Width, Panel1.Height)
'draw the Panel to the bitmap "bmp"
Panel1.DrawToBitmap(bmp, Panel1.ClientRectangle)
I create a multi page tiff by "breaking my datagridview items into pages.
this is how i detect the start of a new page:
'i add the rows to my datagrid one at a time and then check if the scrollbar is active.
'if the scrollbar is active i save the row to a variable and then i remove it from the
'datagridview and roll back my counter integer by one(thus the next run will include this
'row.
Private Function VScrollBarVisible() As Boolean
Dim ctrl As New Control
For Each ctrl In DataGridView_Results.Controls
If ctrl.GetType() Is GetType(VScrollBar) Then
If ctrl.Visible = True Then
Return True
Else
Return False
End If
End If
Next
Return Nothing
End Function
I hope this helps
another easy way and more flexible , after loading data into Datagrid
Private Sub Button_Export_Click(sender As Object, e As EventArgs) Handles Button_Export.Click
Dim file As System.IO.StreamWriter
file = My.Computer.FileSystem.OpenTextFileWriter("c:\1\Myfile.csv", True)
If DataGridView1.Rows.Count = 0 Then GoTo loopend
' collect the header's names
Dim Headerline As String
For k = 0 To DataGridView1.Columns.Count - 1
If k = DataGridView1.Columns.Count - 1 Then ' last column dont put , separate
Headerline = Headerline & DataGridView1.Columns(k).HeaderText
Else
Headerline = Headerline & DataGridView1.Columns(k).HeaderText & ","
End If
Next
file.WriteLine(Headerline) ' this will write header names at the first line
' collect the data
For i = 0 To DataGridView1.Rows.Count - 1
Dim DataRow As String
For k = 0 To DataGridView1.Columns.Count - 1
If k = DataGridView1.Columns.Count - 1 Then
DataRow = DataRow & DataGridView1.Rows(i).Cells(k).Value ' last column dont put , separate
End If
DataRow = DataRow & DataGridView1.Rows(i).Cells(k).Value & ","
Next
file.WriteLine(DataRow)
DataRow = ""
Next
loopend:
file.Close()
End Sub