I have a program that saves data from a simple program on our Shop Floor. The issue I am having is that I am getting duplicate entries I beleive due to collisions with writing to the file at the same time by 2 different people
Do While done = 0 And attempt < 1
done = 1
Try
Using theWriter As New System.IO.StreamWriter(ReportText, True)
For Each currentrow As DataGridViewRow In Me.ReportGrid.Rows
' The Cells are the Columns
For Each currentcolumn As DataGridViewCell In currentrow.Cells
theWriter.Write(currentcolumn.Value & vbTab)
Next
theWriter.WriteLine()
Me.ReportGrid.Rows.Remove(currentrow)'the new line added
Next
theWriter.Close()
End Using
Catch When Err.Number = 75
wait(2000)
done = 0
attempt = attempt + 1
Catch When Err.Number <> 53
Notify()
End Try
Loop
Related
I have been stuck in creating search for Datagridview in Vb.net.
I have one DataGridView that is bound to binding source. It contains data such as:
123456,
213926,
285643,
395687,
I have searched but everywhere but I only found a filter method for binding source or a find method.
The filter method removes remaining rows & find method finds an exact string.
I found a method to find text in DataGridView but that search found the string anywhere in DataGridView column like if user type 2 then it will first select the row having 2 such as 123456.
I want to create search that should find letter in sequence from start & so on.
If the user presses 2 then search should go for cell starting with 2 such as 213926.
Matter solved Frank. Thankyou So Much.
Here is my complete code for others too.
Dim Found As Boolean = False
Dim StringToSearch As String = ""
Dim ValueToSearchFor As String = Me.TextBox1.Text.Trim.ToLower
Dim CurrentRowIndex As Integer = 0
Try
If dgvDishonourReceipts.Rows.Count = 0 Then
CurrentRowIndex = 0
Else
CurrentRowIndex = dgvDishonourReceipts.CurrentRow.Index + 1
End If
If CurrentRowIndex > dgvDishonourReceipts.Rows.Count Then
CurrentRowIndex = dgvDishonourReceipts.Rows.Count - 1
End If
If dgvDishonourReceipts.Rows.Count > 0 Then
For Each gRow As DataGridViewRow In dgvDishonourReceipts.Rows
StringToSearch = gRow.Cells(4).Value.ToString.Trim.ToLower
If InStr(1, StringToSearch, LCase(Trim(TextBox1.Text)), vbTextCompare) = 1 Then
Dim myCurrentCell As DataGridViewCell = gRow.Cells(4)
Dim myCurrentPosition As DataGridViewCell = gRow.Cells(0)
dgvDishonourReceipts.CurrentCell = myCurrentCell
CurrentRowIndex = dgvDishonourReceipts.CurrentRow.Index
Found = True
End If
If Found Then Exit For
Next
End If
Catch ex As Exception
MsgBox(ex.ToString)
End Try
I have an Excel sheet and its humongous.. Around like 200000 rows that needs to be processed.
All I have to do is read it and process them with a query on a DB2 table. I have written the program where its more than 8 hours to process 5000 rows.
Is there a way where I can simultaneously read the excel and execute the query. I want them to be independent of the process. I cannot use Parallel.for as reading and creating so many instance of threads is no advantage. ANy pipes and queues are of no use. THis is a dom method using and it does not read a row, it reads a string.. if there is a null value on the row, it executes the row and throws an null exception. I am well with Background workers and TPL's. Any idea or code would be appreciated. No DLL can be used apart from OPENXML
Ideally I do not want to add to array,, I want it in 2 diff variables and process them when read..
Read a row( only 2 columns, ignore other cols
create a thread to execute the row and in Parallel, execute the read row.
Merge into one single table.
display results.. Sounds simple but there are challenges.
.
Try
Using spreadsheetDocument As SpreadsheetDocument = spreadsheetDocument.Open(fileName, False)
Dim workbookPart As WorkbookPart = spreadsheetDocument.WorkbookPart
Dim worksheetPart As WorksheetPart = workbookPart.WorksheetParts.First()
Dim sheetData As SheetData = worksheetPart.Worksheet.Elements(Of SheetData)().First()
For Each r As Row In sheetData.Elements(Of Row)()
For Each c As Cell In r.Elements(Of Cell)()
Dim text As String
Try
text = c.CellValue.Text.ToString
Debug.Print(text.ToString)
If text IsNot Nothing AndAlso Trim(text).Length > 0 Then
Arr.Add(text.ToString)
End If
text = Nothing
j += 1
Catch
End Try
Next
text = Nothing
Next
End Using
Catch ex As Exception
MsgBox("Exception caught: " + ex.Message)
Debug.Print(ex.Message.ToString)
End
End Try
myArr = CType(Arr.ToArray(GetType(String)), String())
This is the process which is dividing the data into 2 parameters
For i As Integer = 2 To myArr.Count - 1 Step 2
If i And 1 Then
i = i - 1
Else
dstr = DateTime.FromOADate(Double.Parse(myArr(i).ToString())).ToShortDateString()
'Debug.Print(dstr.ToString & "----->" & i.ToString & "TCID--->" & myArr(i + 1).ToString)
DQueue.Enqueue(DateTime.FromOADate(Double.Parse(myArr(i).ToString())).ToShortDateString())
Tqueue.Enqueue((myArr(i + 1).ToString()))
TCArr.Add((myArr(i + 1).ToString()))
dc.Merge(ProcessQueryODBC(dstr, myArr(i + 1).ToString))
If dc.Rows.Count > 0 Then
dt.Merge(dc)
Else
nFound.Merge(CreateDT(dstr, myArr(i + 1).ToString()))
End If
End If
Next
Instead of opening a DB connection through ODBC. Can you export your data to a CSV file and then let DB2 perform the import?
somestring = "import from "myfile.csv" of DEL ...."
DoCmd.RunSQL somestring
I'm a student and I'm on my way to deliver my examproject in Programming on level C.
I'm in the very end of my project, I have programmed a game with a highscore. The highscore saves the score in notepad so it can read the old highscore again when the game is relaunched.
The problem is, everytime a new highscore comes it keep adding a new one. So if I have played 100 games there is 100 highscores and I don't want that. I want to set a limit on my highscore. I'm thinking about 15.
I have two ideas. the first idea is that the program only read the first 15 highscores.
The second idea is that I create a sub that reads the old highscorelist, then compare it with the new highscore and checks if the old highscorelist needs to be updated.
But the problem is, I'm having a big trouble programming that.. I'll now upload my highscore subs, and ask you for help.
This is where I write my highscorelist
Private Sub skrivhighscore()
ReDim Preserve HighscoreNavn(UBound(HighscoreNavn) + 1)
ReDim Preserve HighscoreLevel(UBound(HighscoreLevel) + 1)
'insets the new highscore on the right place so that level is on top
For i As Integer = 1 To UBound(HighscoreLevel)
If (level > HighscoreLevel(i)) Then
'the new highscore is bigger than highscorecount(i). inset the new here but first move the others
For j As Integer = UBound(HighscoreLevel) To i + 1 Step -1
'kopier array(j-1) til array(j)
HighscoreNavn(j) = HighscoreNavn(j - 1)
HighscoreLevel(j) = HighscoreLevel(j - 1)
Next j
HighscoreNavn(i) = brugernavn
' sets highscore name to username. brugernavn = username
HighscoreLevel(i) = level
'set shighscorelvel(I) to the level the user died on.
Exit For
End If
Next i
'clear username and change level to 0
brugernavn = ""
level = 0
'writes highscore to a file so it can be read next time
highscoreboardskriv()
End Sub
This is where I save my highscorelist to notepad
Private Sub highscoreboardskriv()
' create a file at the same place as the game
'append:=False means overwrite and not repleace
fileWriter = My.Computer.FileSystem.OpenTextFileWriter("HighScore.txt", append:=False)
For i As Integer = 1 To UBound(HighscoreLevel)
' In every line the name is on the first 20 spaces and the score is from space 22
'example: "Player1 : 2"
If (HighscoreNavn(i) IsNot Nothing) AndAlso (HighscoreNavn(i).Trim <> "") Then
' If username is empty, it will not be written in the highscorelist. by using this method a highscore can be removed.
FileLine = HighscoreNavn(i).PadRight(20) & ":" & HighscoreLevel(i).ToString.PadLeft(5)
fileWriter.WriteLine(FileLine)
End If
Next i
fileWriter.Close()
End Sub
This is where I show my highscorelist
Private Sub Highscore()
'Now we read both information again from the file
Dim HighScoreText As String = ""
'highscorelist line by line
For i As Integer = 1 To UBound(HighscoreLevel)
'takes every spaces in an array (we dont use the first line)
If (HighscoreNavn(i) IsNot Nothing) AndAlso (HighscoreNavn(i).Trim <> "") Then
If (HighScoreText <> "") Then
'new line by every highscore except the first line
HighScoreText = HighScoreText & vbNewLine
End If
'line 1 example: "player1 : 230"
HighScoreText = HighScoreText & HighscoreNavn(i).PadRight(20) & ":" & HighscoreLevel(i).ToString.PadLeft(5)
End If
Next i
'show highscorelist to user
MsgBox(HighScoreText, Title:="Highscore list")
End Sub
This is where I read my highscorelist from notepad :
Public Sub highscoreboardlæs()
Public HighscoreNavn(0) As String
Public HighscoreLevel(0) As Integer
Public level As Integer = 0
Public fileReader As System.IO.StreamReader
Public FileLine As String
Try
fileReader = My.Computer.FileSystem.OpenTextFileReader("HighScore.txt")
FileLine = fileReader.ReadLine()
While (FileLine <> "") 'loop så længe der er linjer i filen, for at få alle highscores med
'extend array with 1 extra line
ReDim Preserve HighscoreNavn(UBound(HighscoreNavn) + 1)
ReDim Preserve HighscoreLevel(UBound(HighscoreLevel) + 1)
HighscoreNavn(UBound(HighscoreNavn)) = Mid(FileLine, 1, 20)
HighscoreLevel(UBound(HighscoreLevel)) = Val(Mid(FileLine, 22, 5))
'read next line from the file
FileLine = fileReader.ReadLine()
End While
fileReader.Close()
Catch
'i use try method, else it will crash if there arent any highscorelist
End Try
'MsgBox("Highscore: " & vbNewLine & fileReader.ReadLine() & vbNewLine & fileReader.ReadLine() & vbNewLine & fileReader.ReadLine())
End Sub
If you just want to keep 15 scores in the file you could just read all the scores into a array, sort it and write the 15 highest back into the file.
I would not recommend doing that if you have longer score lists, as you load all the scores into the memory, which might give you an OOM (Out Of Memory) exception with bigger lists, but in your case it's completely fine.
Sub AddScore(score%, filePath$)
Dim Scores As New List(Of Integer)
' Loads all the scores into our list
Using Sr As New IO.StreamReader(filePath)
Do Until Sr.EndOfStream
Scores.Add(Sr.ReadLine)
Loop
End Using
Scores.Sort() ' Sort it
Scores.Reverse() ' Reverse it, as the the highest scores is at the bottom. You would property want to just read trough the last 15 items in the list rather than reversing it, but I'm just being lazy.
' Write the first 15
Using Sw As New IO.StreamWriter(filePath, False)
For i = 0 To Math.Min(Scores.Count - 1, 14)
Sw.WriteLine(Scores(i))
Next
End Using
End Sub
Oh, and btw, your Swedish right? Would you mind sending me a PM, as I'm quite interested in how programming school is in Sweden.
I am using split function and assigning the value in a variable and running the code in loop after few iterations its giving an error of "This array is fixed or temporarily locked (Visual Basic)"..
e.g; here value of movies_cat1 read from excel is in form of this------
"Movies->List All Movies , Movies->World Cinema->Asia , Movies->Movies by Language->Sinhalese , Movies->Drama"
For crow = 1 To 100
Value = Worksheets("Movies_categories").Range("A" & crow).Value
cat_final = Worksheets("Movies_categories").Range("B" & crow).Value
If Value = "y" Or Value = "Y" Then
'Loop for reading the data from tabsheet- Movies
For crowss = 5 To 3000
movies_cat1 = Worksheets("Movies").Range("B" & crowss).Value
movies_language = Worksheets("Movies").Range("C" & crowss).Value
If movies_language = "English" Then
Temp = Split(movies_cat, ",") 'run time Error:10 occurs here..
For Each boken_c In Temp
flag = 0
boken_c = Trim(boken_c)
If RTrim(LTrim(boken_c)) = LTrim(RTrim(cat_final)) Then
flag = 1
GoTo Line4:
End If
Next boken_c
End If
Next crowss
End If
Line4: Next crow
Error occurs at this statement: Temp = Split(movies_cat, ","), it says that the array is fixed or temporarily locked, because i think initially its taking 'temp' as a variable, but while returning the value of split function, variable 'Temp' becomes array after completion of first loop(i.e after crow = 6,7....)
Your line4 label is outside the for loop on the temp variable so when you goto it leaves it locked.
You really should restructure your code to not use a goto inside the for each loop.
Maybe:
For crow = 1 To 100
Value = Worksheets("Movies_categories").Range("A" & crow).Value
cat_final = Worksheets("Movies_categories").Range("B" & crow).Value
If Value = "y" Or Value = "Y" Then
'Loop for reading the data from tabsheet- Movies
For crowss = 5 To 3000
movies_cat1 = Worksheets("Movies").Range("B" & crowss).Value
movies_language = Worksheets("Movies").Range("C" & crowss).Value
If movies_language = "English" Then
Temp = Split(movies_cat, ",") 'run time Error:10 occurs here..
For Each boken_c In Temp
flag = 0
boken_c = Trim(boken_c)
If RTrim(LTrim(boken_c)) = LTrim(RTrim(cat_final)) Then
flag = 1
**Exit For**
End If
**If flag = 1 Then Exit For**
Next boken_c
End If
**If flag = 1 Then Exit For**
Next crowss
End If
Next crow
(Note the **d lines.)
I had this problem too with VBA. I cannot say I am proud of how I managed to get it, but it is supplied here just in can anyone else accidentally slips up on this.
It is quite interesting to debug as the failure occurs at the call to a sub or function - not at the point of failure. Luckily, you can follow the code through to the offending line of the called routine before it reports the error.
Call Sub1(gArray(3))
debug.print gArray(3)
...
Sub Sub1(i as integer)
Redim gArray(0)
End sub
Clearly the VB RT is not going to like this as by the time the debug.print executes, the array dimension does not exist. Ok why the hell would you want to pass a globally declared array anyway? Guilty as charged.
So in the example above you get the error at the call to Sub1, but the thing causing it is the Redim in the sub.
The moral to the story is do not pass global variables as parameters to subs. Another simple fix is to declare the Sub1 slightly differently:
Sub Sub1(ByVal i as integer)
This means the i variable is copied (but not returned) by the Sub.
Thanks, Deanna for the answer! I have a similar message on ReDim Preserve statement at the last line in next fragment of code:
If StrComp(Mid(s, 1, lE), txtE, vbBinaryCompare) = 0 Then
For i = iMdl To 1 Step -1
With blks(i)
If .lnEnd = 0 Then ' ".lnEnd" is a member of blks(i)
.lnEnd = ln
GoTo NXT
End If
End With
Next
errBegWith = errBegWith & ln & ", "
NXT:
End If
'...
ReDim Preserve blks(iMdl)
And after extracting assignment .lnEnd = ln from inside of the With the program works fine:
If StrComp(Mid(s, 1, lE), txtE, vbBinaryCompare) = 0 Then
For i = iMdl To 1 Step -1
If blks(i).lnEnd = 0 Then
blks(i).lnEnd = ln
GoTo NXT
End If
Next
errBegWith = errBegWith & ln & ", "
NXT:
End If
'...
ReDim Preserve blks(iMdl)
I am working on an Excel report and I would like the top rows to be empty to allow for an image to be inserted. However, I do not want the image size to change the width of the columns and would rather the data below do that.
This is what I have so far:
If ComDset.Tables(0).Rows.Count > 0 Then
Try
With Excel
.SheetsInNewWorkbook = 1
.Workbooks.Add()
.Worksheets(1).Select()
Dim i As Integer = 1
For col = 0 To ComDset.Tables(0).Columns.Count - 1
.cells(1, i).value = ComDset.Tables(0).Columns(col).ColumnName
.cells(1, i).EntireRow.Font.Bold = True
i += 1
Next
i = 2
Dim k As Integer = 1
For col = 0 To ComDset.Tables(0).Columns.Count - 1
i = 2
For row = 0 To ComDset.Tables(0).Rows.Count - 1
.Cells(i, k).Value = ComDset.Tables(0).Rows(row).ItemArray(col)
i += 1
Next
k += 1
Next
filename = "ShiftReport" & Format(MdbDate, "dd-MM-yyyy") & ".xls"
.ActiveCell.Worksheet.SaveAs(filename)
End With
System.Runtime.InteropServices.Marshal.ReleaseComObject(Excel)
Excel = Nothing
Catch ex As Exception
MsgBox(ex.Message)
End Try
' The excel is created and opened for insert value. We most close this excel using this system
Dim pro() As Process = System.Diagnostics.Process.GetProcessesByName("EXCEL")
For Each i As Process In pro
i.Kill()
Next
End If
I would recommend trying to "merge" the cells in the top 2 rows. You could take A1 through say K2 and merge them and the image would fit just fine in there...
Range("A1:K2").Select
Selection.Merge
One way to create your report with the image included is to create a template workbook (.xlt file) in which you have already set up your required formatting and image(s). Then in your code, create the new report workbook from the template like this:
.Workbooks.Add("path\to\report_template.xlt")
To make your image fixed in size and independent of column widths, right-click on it, choose "Format Picture...", open the Properties tab and within Object Positioning select "Don't move or size with cells".
Alternatively, use code to add the picture to a blank workbook as follows:
ActiveSheet.Pictures.Insert( "path\to\image.jpg" ).Select
With Selection
.Placement = xlFreeFloating
.PrintObject = True
End With
You could control the first row to be used to output your data by initialising a row variable to an appropriate value.
You can also fit the column sizes to match your data by using the AutoFit method.
Your code might then look like this:
Try
With Excel
.SheetsInNewWorkbook = 1
.Workbooks.Add("path\to\report_template.xlt")
.Worksheets(1).Select()
Dim outputRow As Integer = 8
For col = 0 To ComDset.Tables(0).Columns.Count - 1
.Cells(outputRow, col+1).value = ComDset.Tables(0).Columns(col).ColumnName
.Cells(outputRow, col+1).EntireRow.Font.Bold = True
Next
outputRow += 1
For y = 0 To ComDset.Tables(0).Rows.Count - 1
For x = 0 To ComDset.Tables(0).Columns.Count - 1
.Cells(outputRow + y, x).Value = ComDset.Tables(0).Rows(y).ItemArray(x)
Next
Next
.Cells(outputRow, 1).CurrentRegion.Columns.AutoFit
filename = "ShiftReport" & Format(MdbDate, "dd-MM-yyyy") & ".xls"
.ActiveCell.Worksheet.SaveAs(filename)
End With
System.Runtime.InteropServices.Marshal.ReleaseComObject(Excel)
Excel = Nothing
Catch ex As Exception
MsgBox(ex.Message)
End Try
Choose a suitable initial value for the outputRow variable to give enough space for your image.
An alternate to consider, if the image is only needed for printed reports, is to put it into the page header.
Worksheets(1).PageSetup.LeftHeaderPicture.Filename = "C:\header.JPG"
The image will be embedded in the file. It will only be visible in 'Print preview' mode and when printing the report.