Word split fails with more then 3 words - vb.net

I try to split a string every + then every |, it works fine when I try to read only 3 words from the split words1(0-3), but when I try to read words1(4) the whole function fails... here is the code:
Private Function SetUpdateData()
Try
Dim delimiterChars As Char() = {"+"c}
Dim words As String() = updatelist.Split(delimiterChars)
Dim i As Integer = 1
Do While (i < words.Length)
Dim delimiterChars1 As Char() = {"|"c}
Dim words1 As String() = words(i).Split(delimiterChars1)
Dim name As String = words1(0)
Dim version As String = words1(1)
Dim fileurl As String = words1(2)
Dim size As String = (words1(3) / 1024D / 1024D).ToString("0.00") & " MB"
Dim cversion As FileVersionInfo = FileVersionInfo.GetVersionInfo(Path.Combine(Directory.GetCurrentDirectory() & "\" & name))
If My.Computer.FileSystem.FileExists(Directory.GetCurrentDirectory() & "\" & name) Then
If Not version.Contains(cversion.FileVersion) Then
DataGridView1.Rows.Add(name, version, size)
RichTextBox1.AppendText("+" & words1(0) & "|" & words1(1) & "|" & words1(2) & "|" & words1(3))
End If
Else
DataGridView1.Rows.Add(name, version, size)
RichTextBox1.AppendText("+" & words1(0) & "|" & words1(1) & "|" & words1(2) & "|" & words1(3))
End If
i = (i + 1)
Loop
Catch ex As Exception
MsgBox("error")
End Try
End Function
This above works no problem at all, but when you add words1(4) in like this:
Private Function SetUpdateData()
Try
Dim delimiterChars As Char() = {"+"c}
Dim words As String() = updatelist.Split(delimiterChars)
Dim i As Integer = 1
Do While (i < words.Length)
Dim delimiterChars1 As Char() = {"|"c}
Dim words1 As String() = words(i).Split(delimiterChars1)
Dim name As String = words1(0)
Dim version As String = words1(1)
Dim fileurl As String = words1(2)
Dim size As String = (words1(3) / 1024D / 1024D).ToString("0.00") & " MB"
Dim status As String = words1(4)
Dim cversion As FileVersionInfo = FileVersionInfo.GetVersionInfo(Path.Combine(Directory.GetCurrentDirectory() & "\" & name))
If My.Computer.FileSystem.FileExists(Directory.GetCurrentDirectory() & "\" & name) Then
If Not version.Contains(cversion.FileVersion) Then
DataGridView1.Rows.Add(name, version, size)
RichTextBox1.AppendText("+" & words1(0) & "|" & words1(1) & "|" & words1(2) & "|" & words1(3) & "|" & words(4))
End If
Else
DataGridView1.Rows.Add(name, version, size)
RichTextBox1.AppendText("+" & words1(0) & "|" & words1(1) & "|" & words1(2) & "|" & words1(3) & "|" & words(4))
End If
i = (i + 1)
Loop
Catch ex As Exception
MsgBox("error")
End Try
End Function
ALSO the string that it is splitting is:
+Thing v2.exe|1.0.0.1|http://example.com/uploads/Thing v2.exe|205824|Primary+Thing v2 DLL.dll|1.0.0.1|http://example.com/uploads/Thing DLL.dll|1097728|Secondary
Which all should output:
words1(0) - Thing v2.exe
words1(1) - 1.0.0.1
words1(2) - http://example.com/uploads/Thing v2.exe
words1(3) - 205824
words1(4) - Primary
But as I said above once words1(4) is used it crashes the whole function...
It will catch and fail and give the error message, but when I try to do msgbox(ex) for the exception error, no msgbox pops up and the program just continues.
If anyone can fix the issue or give me some help that would be greatly appreciated, thanks in advance and sorry if this is confusing as it is to me too!

There are two loops in your program:
Loop1:
words1(0)>>Thing v2.exe
words1(1)>>1.0.0.1
words1(2)>>http://example.com/uploads/Thing v2.exe
words1(3)>>205824
words1(4)>>Primary
Loop2:
words1(0)>>Thing v2 DLL.dll
words1(1)>>1.0.0.1
words1(2)>>http://example.com/uploads/Thing DLL.dll
words1(3)>>1097728
words1(4)>>Secondary
it appears that you misspelled your words1(4) to words(4) in below line
RichTextBox1.AppendText("+" & words1(0) & "|" & words1(1) & "|" & words1(2) & "|" & words1(3) & "|" & words(4))

Your split functionality works fine but there's an error on the following lines (there are 2 of them):
RichTextBox1.AppendText("+" & words1(0) & "|" & words1(1) & "|" & words1(2) & "|" & words1(3) & "|" & words(4))
The last words(4) should be words1(4).

Related

Writing large amounts of data to a csv file

I couldn't find anything specific to this so here goes.
I have a For Each loop where I want to write values to a csv file. Currently, I use a WriteToFile function:
Public Sub WriteToFile(stuff as string, morestuff as string, moremorestuff as string))
Dim strFile As String = "\\SomeServer\somefilepath\WriteTo.csv"
Try
If System.IO.File.Exists(strFile) = True Then
'rename with startdate and enddate. Always want to create new
Dim objWriter As New System.IO.StreamWriter(strFile, True)
objWriter.WriteLine(Stuff & "," & MoreStuff & "," & Moremorestuff)
objWriter.Close()
Else
Dim writeFile As IO.StreamWriter
writeFile = IO.File.CreateText(strFile)
writeFile.WriteLine("Stuff" & "," & "MoreStuff" & "," & "MoreMoreStuff")
writeFile.WriteLine(Stuff & "," & MoreStuff & "," & MoreMoreStuff)
writeFile.Close()
End If
Catch ex As Exception
MessageBox.Show("An error has occured in the WriteToFile subroutine: " & ex.ToString) ' & vbCrLf & strPlugin & vbCrLf & strVersion)
End Try
End Sub
Rather than closing the StreamWriter after every record is written, is there a way to keep it open? Or should it be kept open?
I made some changes and came up with this. However, using this code, how would I create a header in the csv file?
If cur.Count > 0 Then
Using writer As System.IO.StreamWriter = New IO.StreamWriter("C:\Temp\UWConditions.csv")
For Each lrdata As LoanReportData In cur
loan = session.Loans.Open(lrdata.Guid)
If Not IsNothing(loan) Then
For Each condition As UnderwritingCondition In loan.Log.UnderwritingConditions
Title = condition.Title.Replace(",", "")
Desc = condition.Description.Replace(",", "")
UWName = loan.Session.Users.GetUser(loan.Fields("UWID").Value).FullName.Replace(",", "")
writer.WriteLine(lrdata("Loan.LoanNumber") & "," & Title & "," & Desc & "," & UWName)
Next
loan.Close()
End If
Next
End Using
End If

An app operating under Windows 10 finds a byteOrderMarkUtf8 in a string, but there isn't one in the string

I have an app that receives an XML string and tries to clean it up before processing. For some reason, under the Windows 10 operating system, the app thinks there is a byteOrderMarkUtf8 leading the string. There isn't one.
The first character is "<". The app removes the "<", and then removes the rest of the tag, too, creating an invalid XML.
This used to work under Windows 7.
In the code below, I have commented the offending section out.
Is there something about character encoding that has changed with Windows 10 that would be causing this?
Private Sub CleanXML(ByRef InString As String)
' This subroutine cleans trash characters out of XML streams
If (InString = "") Then
MessageBox.Show("Null String passed to CleanXML." & vbCr & _
"String Length: " & InString.Length & vbCr & _
"Instring: " & InString & vbCr)
End If
If (InString.Length = 0) Then
MessageBox.Show("String of 0 length or null String passed to CleanXML." & vbCr & _
"String Length: " & InString.Length & vbCr & _
"Instring: " & InString & vbCr)
End If
Dim CleanString As String = InString
CleanString = CleanString.Trim() ' Trim leading and trailing spaces
CleanString = CleanString.Replace("- ", "") ' Replace the dashes
CleanString = CleanString.Replace(" <", "<") ' Replace some white space
CleanString = CleanString.Replace(" <", "<") ' Replace some white space
CleanString = CleanString.Replace("-<", "<") ' Replace dash+lessthan with lessthan
CleanString = CleanString.Replace("- <", "<") ' Replace dash+space+lessthan with lessthan
CleanString = CleanString.Replace("&", "&") ' Replace & with &
Dim Tempstring As String = ""
If CleanString.Length > 0 Then
Try
Dim byteOrderMarkUtf8 = Encoding.UTF8.GetString(Encoding.UTF8.GetPreamble())
' This is the offending code that I have commented out.
'-------------------------------------------------------------
'If (CleanString.StartsWith(byteOrderMarkUtf8)) Then
' CleanString = CleanString.Remove(0, byteOrderMarkUtf8.Length)
'End If
'If (CleanString.EndsWith(byteOrderMarkUtf8)) Then
' CleanString = CleanString.Remove(CleanString.Length - 1, byteOrderMarkUtf8.Length)
'End If
'-------------------------------------------------------------
' Make sure the first and last characters are "<" and ">".
Tempstring = CleanString
Do Until (CleanString.StartsWith("<") Or (CleanString.Length = 0))
CleanString = CleanString.Remove(0, 1)
Loop
Do Until (CleanString.EndsWith(">") Or (CleanString.Length = 0))
CleanString = CleanString.Remove(CleanString.Length - 1, 1)
Loop
Catch ex As Exception
MessageBox.Show("Error in CleanXML." & vbCr & _
"String Length: " & CleanString.Length & vbCr & _
"Instring: " & InString & vbCr & _
"CleanString: " & CleanString & _
" Length: " & CleanString.Length.ToString)
MessageBox.Show(ex.Message + " Inner exception: " + ex.InnerException.Message)
MessageBox.Show(Tempstring)
End Try
Else
MessageBox.Show("Clean string of 0 length in CleanXML." & vbCr & _
"String Length: " & CleanString.Length & vbCr & _
"Instring: " & InString & vbCr & _
"CleanString: " & CleanString)
End If
' Remove any BOMs (Byte-Order Marks) from the string.
'Dim i As Integer = InStr(1, CleanString, byteOrderMarkUtf8)
'Do Until i = 0
' CleanString = CleanString.Remove(i - 1, byteOrderMarkUtf8.Length)
' i = InStr(i, CleanString, byteOrderMarkUtf8)
'Loop
InString = CleanString
End Sub

Getting round Max string size of 32347 in a VBA function

My VBA function stops working with one additional line of code. The final line of code in the working function is: returnString = returnString + "some text from some cell". If I copy paste that line of code, it breaks.
The only cause I can see is string length. When I output the length of returnString in the working function it is 32347. EDIT: So 32347 works, but adding a further 10 characters or so it starts to fail. This looks suspiciously close to a maximum length of some sort. Is there any way round this?
At the moment I am using this Function (not Sub) to return the string to an Excel cell. A separate Sub-routine then picks up the contents of the cell, to integrate it with other data and output a JSON file.
This question appears to ask the same thing, but the max was 255, and so the answers don't help me: Getting around the Max String size in a vba function?. Please note, though, that when I save the 32347-length string, it is 32k. So I can't have hit the 2GB limit!
Any help appreciated!
Function getData(str)
Dim lArray() As String
Dim pData As String
Dim ctr As Integer
Dim ctr2 As Integer
Dim ctr3 As Integer
Dim returnString As String
Set rangetoexport = Worksheets("mysheet").Range("c2:m2728")
Dim id As Long
Dim rowRef As Long
Dim colRef As Integer
Dim var(47) As String
Const idColumn = 1
Const webColumn = 2
Const nameColumn = 3
Const revColumn = 4
Const empColumn = 5
Const ctryColumn = 10
Const indyColumn = 11
Const numFactors = 47
Const labelRow = 1
Const apost = """"
lArray = Split(str, ",")
returnString = "["
If UBound(lArray) <> 0 Then
pData = ""
For ctr = 0 To UBound(lArray)
'Open the object
returnString = returnString + "{"
'Find the row
id = lArray(ctr)
rowRef = -1
For ctr2 = 0 To rangetoexport.Rows.Count
If rangetoexport.Cells(ctr2, idColumn) = id Then
rowRef = ctr2
Exit For
End If
Next
'add the parts
'add the ID and new object
returnString = returnString & """company"": {"
returnString = returnString & """ID"":" & rangetoexport.Cells(rowRef, idColumn) & ","
returnString = returnString & """Website"":""" & rangetoexport.Cells(rowRef, webColumn) & ""","
returnString = returnString & """Company Name"":""" & rangetoexport.Cells(rowRef, nameColumn) & ""","
returnString = returnString & """Revenue"":""" & rangetoexport.Cells(rowRef, revColumn) & ""","
returnString = returnString & """Employee Count"":" & rangetoexport.Cells(rowRef, empColumn) & ","
returnString = returnString & """Country"":""" & rangetoexport.Cells(rowRef, ctryColumn) & ""","
returnString = returnString & """Industry Classification (SIC4)"":""" & rangetoexport.Cells(rowRef, indyColumn) & """}},"
'returnString = returnString & """factors"": {"
'For ctr3 = 1 To 10
'Next
'returnString = returnString & apost & rangetoexport.Cells(labelRow, 12) & apost & ":" & rangetoexport.Cells(rowRef, 12) & ","
'returnString = returnString & apost & rangetoexport.Cells(labelRow, 12) & apost & ":" & rangetoexport.Cells(rowRef, 12) & ","
'returnString = returnString & apost & rangetoexport.Cells(labelRow, 12) & apost & ":" & rangetoexport.Cells(rowRef, 12) & ","
'returnString = returnString & apost & rangetoexport.Cells(labelRow, 12) & apost & ":" & rangetoexport.Cells(rowRef, 12) & ","
'returnString = returnString & rangetoexport.Cells(rowRef, webColumn) & "},"
Next
Else
returnString = ""
End If
returnString = Left(returnString, Len(returnString) - 1)
getData = returnString & "]"
I would recommend the use of an Array instead. You could create a dynamically sized array and at the end, it is easier to manipulate it.

How to add new display in textbox without replacing the first input

Hi I am creating a chat like application. Can you kindly help me?
When I am entering a new message the initial displayed message is getting replaced :(
Please see my codes below:
Private Sub saveMessage()
FileName = Format(Now, "MMddyyyyhhmmss")
Dim RecipientFile As String
If CurrentRecipient = "Edward" Then
RecipientFile = RecipientFolder & FileName & ".txt"
ElseIf CurrentRecipient = "Criziel" Then
RecipientFile = RecipientFolder & FileName & ".txt"
ElseIf CurrentRecipient = "Jerome" Then
RecipientFile = RecipientFile & FileName & ".txt"
Else
Exit Sub
End If
Dim Writer As IO.StreamWriter
Writer = New IO.StreamWriter(RecipientFile)
Writer.Write(MainRichTextBox.Text)
Writer.Close()
ShowtextRichTextBox.Text = (User & " : ") & MainRichTextBox.Text
MainRichTextBox.Clear()
End Sub
Thank you in advance ! :*
Your below code is just assigning (replacing) the latest value to the Rich TextBox,
ShowtextRichTextBox.Text = (User & " : ") & MainRichTextBox.Text
Instead, you should append the text as below,
ShowtextRichTextBox.Text &= (User & " : ") & MainRichTextBox.Text
Also, you can try the inbuild method of RichTextBox to append the text like, ShowtextRichTextBox.AppendText((User & " : ") & MainRichTextBox.Text)
Note: When appending, you should also add newline before the new text like, ShowtextRichTextBox.Text &= Environment.NewLine & (User & " : ") & MainRichTextBox.Text.
Modified code,
Private Sub saveMessage()
FileName = Format(Now, "MMddyyyyhhmmss")
Dim RecipientFile As String
If CurrentRecipient = "Edward" Then
RecipientFile = RecipientFolder & FileName & ".txt"
ElseIf CurrentRecipient = "Criziel" Then
RecipientFile = RecipientFolder & FileName & ".txt"
ElseIf CurrentRecipient = "Jerome" Then
RecipientFile = RecipientFile & FileName & ".txt"
Else
Exit Sub
End If
Dim Writer As IO.StreamWriter
Writer = New IO.StreamWriter(RecipientFile)
Writer.Write(MainRichTextBox.Text)
Writer.Close()
ShowtextRichTextBox.Text &= Environment.NewLine & (User & " : ") & MainRichTextBox.Text
MainRichTextBox.Clear()
End Sub

VBA text to columns with "" delimiters

I will be quick.
I have a variable 'strLine' with text:
The exact string will look like that:
"Text1","Text2","Text3","Text4","Text5"
So, delimiter in my case is: "
How I can extract text and write it in columns.
Expecting results in cells:
A1=Text1
B1=Text2
C1=Text3
D1=Text4
E1=Text5
Thanks
Use Split function, it'll return a 0-based array (ergo +1 in cells) :
Sub test_Andy()
Dim StrLine As String
Dim Str() As String
StrLine = Range("A2").Value 'If your value is in A2
'If you input the value manually, not really practical with so much "
StrLine = Chr(34) & "Text1" & Chr(34) & "," & Chr(34) & "Text2" & Chr(34) & "," & Chr(34) & "Text3" & Chr(34) & "," & Chr(34) & "Text4" & Chr(34) & "," & Chr(34) & "Text5" & Chr(34)
Debug.Print StrLine '"Text1","Text2","Text3","Text4","Text5"
Str = Split(StrLine, ",")
Dim i As Integer
For i = LBound(Str) To UBound(Str)
Cells(1, i + 1) = Str(i)
Cells(2, i + 1) = Replace(Str(i), Chr(34), vbNullString)
Next i
End Sub
You can use Split to split the text into an array, then remove the " from the start and the end of the parts using Mid :
strText = """Text1"",""Text2"",""Text3"",""Text4"",""Text5"""
aSplit = Split(strText, ",")
For Each strCurrent in aSplit
MsgBox Mid(strCurrent, 2, Len(strCurrent) - 2)
Next
Remark : You might want to add some checks to ensure that there is a " at the start and end before removing them.
edited to simulate a StrLine loop:
Dim iRow As Long
irow = 1
For Each StrLine In StrLines '<--' assuming a loop through many StrLines
Str = Split(Replace(StrLine, """", ""), ",")
Cells(iRow, 1).Resize(, UBound(Str) - LBound(Str)).Value = Str
iRow = iRow + 1
Next