Replace function, how to replace not all founded strings? - vba

I create XML file from excel file. I save a string from one cell in a variable sObserved. When in that string I have a character "&" it should be replaced to "&"and when I have a character ";" it should be replaced to ";".
I use for this function Replace, this is my code:
sObserved = Replace(sObserved, "&", "&")
sObserved = Replace(sObserved, ";", ";")
But this can't work good, because when it will replace "&" on "&", the ";" will appear and next operation will change it to "&"
If I'll change an order it also will be wrong, because then sign "&" in "&#59" will be replaced.
Is there any possibility to replace it just like I wanted? I will be gratefull for any ideas because I stuck here.

Try this:
sObserved = Replace(sObserved, "&", "&")
sObserved = Replace(sObserved, ";", ";")
sObserved = Replace(sObserved, "&", "&")

This function is from http://www.codeproject.com/Articles/33064/VBScript-HTML-Encode. You may need to tweek it but it does a character by character check.
Function HTMLEncode(ByVal sVal)
sReturn = ""
If ((TypeName(sVal)="String") And (Not IsNull(sVal)) And (sVal<>"")) Then
For i = 1 To Len(sVal)
ch = Mid(sVal, i, 1)
Set oRE = New RegExp : oRE.Pattern = "[ a-zA-Z0-9]"
If (Not oRE.Test(ch)) Then
ch = "&#" & Asc(ch) & ";"
End If
sReturn = sReturn & ch
Set oRE = Nothing
Next
End If
HTMLEncode = sReturn
End Function

What you're after is a function to encode the output to be HTML friendly: htmlEncode. There are several scripts/functions around the web people have wrote, here is one:
' Encode an string so that it can be displayed correctly
' inside the browser.
'
' Same effect as the Server.HTMLEncode method in ASP
Function HTMLEncode(ByVal Text As String) As String
Dim i As Integer
Dim acode As Integer
Dim repl As String
HTMLEncode = Text
For i = Len(HTMLEncode) To 1 Step -1
acode = Asc(Mid$(HTMLEncode, i, 1))
Select Case acode
Case 32
repl = " "
Case 34
repl = """
Case 38
repl = "&"
Case 60
repl = "<"
Case 62
repl = ">"
Case 32 To 127
' don't touch alphanumeric chars
Case Else
repl = "&#" & CStr(acode) & ";"
End Select
If Len(repl) Then
HTMLEncode = Left$(HTMLEncode, i - 1) & repl & Mid$(HTMLEncode, _
i + 1)
repl = ""
End If
Next
End Function
ref: http://www.devx.com/vb2themax/Tip/19162
There is another here: http://www.codeproject.com/Articles/33064/VBScript-HTML-Encode
but that seems to encode everything that's not a character or letter. The regex in this one could probably be expanded a little better to include those that are ok for HTML.
Function HTMLEncode(ByVal sVal)
sReturn = ""
If ((TypeName(sVal)="String") And (Not IsNull(sVal)) And (sVal<>"")) Then
For i = 1 To Len(sVal)
ch = Mid(sVal, i, 1)
Set oRE = New RegExp : oRE.Pattern = "[ a-zA-Z0-9]"
If (Not oRE.Test(ch)) Then
ch = "&#" & Asc(ch) & ";"
End If
sReturn = sReturn & ch
Set oRE = Nothing
Next
End If
HTMLEncode = sReturn
End Function

Related

Name depends on the number of characters

How to write a conditional statement acting as follows:
If "% name%" has 1 character, name: 00 "% name%"
If "% name%" has 2, name: 0 "% name%"
If "% name%" has 3 , name: "% name%"
action.SetDynamicParameter("FileName", ((((((("%version%" + "_") _
+ String.Join(", ", array2)) _
+ "_") _
+ "%name%") _
+ ".jpg"))
I will be grateful for your help.
It looks to me like your just trying to pad a number as a string with leading zeros to a length of 3. Is that correct? If so, try this:
Private Function FormatMyName(ByVal Name As String) As String
Return Name.PadLeft(3, "0")
End Function
If created it as a function so it's easier for you to add the additional formatting you need (e.g. adding a .jpg extension)
Check the return of the Function for Nothing or check the length of the string before passing it to the Function.
Private Function GetPaddedName(OriginalName As String) As String
Dim PaddedString As String = ""
Select Case OriginalName.Length
Case 1
PaddedString = "00" & OriginalName & ".jpg"
Case 2
PaddedString = "0" & OriginalName & ".jpg"
Case 3
PaddedString = OriginalName & ".jpg"
Case Else
PaddedString = Nothing
End Select
Return PaddedString
End Function

How do you replace the last occurance of a , with the word "and"?

How do you replace the last occurance of a , with the word and? Can you please give me an idea?
i have 3 checkboxes, 1 rich textbox
to display the output, 1 button
(Aparri) or (Camalanuigan) or (Lallo)
Cagayan(Aparri, Camalanuigan) or Cagayan(Aparri,Camalanuigan,Lallo)
I would like the output to be like this: #Cagayan(Aparri and Camalanuigan) or #Cagayan(Aparri,Camalanuigan And Lallo)
this is my code:
Dim rws As String
If Aparri.Checked = True Then
close_parenthesis.Checked = True
If rws = "" Then
rws = "(" + Aparri.Text
End If
End If
If Aparri.Checked = False Then
rws = ""
End If
If Camalanuigan.Checked = True Then
close_parenthesis.Checked = True
If rws = "" Then
rws = "(" + Camalanuigan.Text
Else
rws = rws & ", " & Camalanuigan.Text
End If
End If
If Lallo.Checked = True Then
close_parenthesis.Checked = True
If rws = "" Then
rws = "(" + Lallo.Text
Else
rws = rws & ", " & Lallo.Text
End If
End If
If close_parenthesis.Checked = True Then
If rws = "" Then
Else
rws = rws + close_parenthesis.Text
End If
End If
Display.Text = rws.ToString
Output: (Aparri,Camalanuigan,Lallo)
i want the out like this (Aparri,Camalanuigan and Lallo)
Here, I haven't even seen your code but I get what you want to do by looking at the picture. It can be done in shorter version but I have explained what's going on in each and every line so it's lengthy.
I have written this code:
'let's say the string is "Aparri, Camalanuigan, Lallo" . that's what your code does, right?
dim Strng as string = "Aparri, Camalanuigan, Lallo"
'now find the position of last appearing ","
Dim comaposition As Integer
comaposition = Strng.LastIndexOf(",") 'it is zero based
'if not found, it will return -1 and u can exit, no need to do the work
if commaposition = "-1" then
exit sub
end if
'remove the comma
Dim String_After_Removing_Comma As String
String_After_Removing_Comma = Strng.Remove(comaposition, 1)
'add "and" in the same position where comma was found
Dim final_string As String
final_string = String_After_Removing_Comma.Insert(comaposition, " and")
'show it on the textbox
DisplayTxt.Text = final_string
You can do this thing after finding your final string (rws in your code).
Hope this helps
You can use the following function to replace last occurrence.
Public Function ReplaceLastOccurrence(ByVal source As String, ByVal searchText As String, ByVal replace As String) As String
Dim position = source.LastIndexOf(searchText)
If (position = -1) Then Return source
Dim result = source.Remove(position, searchText.Length).Insert(position, replace)
Return result
End Function
and you use display text as
Display.Text = ReplaceLastOccurence(rws, ",", "and")
in your last line of code
You always can do it by yourself with single loop and knowledge about last index
' Create array of selected strings
Dim selectedTexts =
New List(Of CheckBox) From { Aparri, Camalanuigan, Lallo }.
Where(Function(checkbox) checkbox.Checked).
Select(Function(checkbox) checkbox.Text).
ToArray()
' Separate selected strings by delimeters
Dim lastIndex = selectedTexts.GetUpperBound(0)
Dim builder = New StringBuilder()
For i As Integer = 0 To lastIndex
If i > 0 Then
Dim delimeter = If(lastIndex > 0 AndAlso lastIndex = i, " and ", ", ")
builder.Append(delimeter)
End If
builder.Append(test(i))
Next
' Wrap with parenthesis if result not empty
If builder.Length > 0 Then
builder.Insert(0, "(")
Dim close = If(close_parenthesis.Checked, close_parenthesis.Text, "")
builder.Append(close)
End If
' Print result
Display.Text = builder.ToString()

Not able to replace apostrophe value from text file

I have a text file. I am reading all data from that text file. I have given code like this for removing all apostrophe and column, and double quotes, and comma.
sr = New StreamReader(Filename)
temp_data = sr.ReadLine
While Not temp_data = Nothing
'While sr.Peek() >= 0
sTemp = Split(temp_data, "|", -1)
Dim i As Integer
For i = 0 To sTemp.Length - 1
Replace(sTemp(i), ",", "")
Replace(sTemp(i), "'", "")
Replace(sTemp(i), """", "")
Next
Then I am assigning value like this:
POnum = Trim(sTemp(0))
POline = Trim(sTemp(1))
PORelnum = Trim(sTemp(2))
But still I am getting value with apostrophe. What is wrong with my code.
you have been trying to replace an array value within its scope.But it is easier to replace that value when it is assigned to a string and then it is assigned.here the code
Dim i As Integer = 0
Dim temp_data As String
Dim clean As String = String.Empty
While Not sr.EndOfStream
temp_data = reader.ReadLine()
Dim sTemp = temp_data .Split("|")
For Each j As String In sTemp
clean = j
clean = clean.Replace("'", "").Replace("""", "").Replace(",", "")
sTemp(i) = clean
i += 1
Next
End While
this will help you..
You are not saving the string that has the replaced text. Consequently it is lost. You should save it back in sTemp(i)
For i = 0 To sTemp.Length - 1
sTemp(i) = Replace(sTemp(i), ",", "")
sTemp(i) = Replace(sTemp(i), "'", "")
sTemp(i) = Replace(sTemp(i), """", "")
Next
However I think a better way would be to remove these characters before splitting so that there is no need to loop and remove from the array.
While Not temp_data = Nothing
temp_data = temp_data.Replace( ",", "").Replace( "'", "").Replace("""", "")
sTemp = Split(temp_data, "|", -1)
'-- no need to loop and replace now
This saves a lot of unnecessary code, isn't it?

VB.net string join, adds unneeded space

Having some issues in vb.net string to join two strings together for output to a txt document. My text document is getting an extra space between the two strings I join. This should not be happening.
If System.IO.File.Exists(path) = True Then
' Create a file to write to.
Dim sw As StreamWriter = System.IO.File.CreateText(path)
sw.WriteLine("Attribute VB_Name = " & Chr(34) & "KbTest" & Chr(34))
sw.WriteLine("")
sw.WriteLine("Public Sub DoKbTest()")
sw.WriteLine("'code here")
sw.WriteLine("Dim catia")
sw.WriteLine("set catia = GetObject(, " & Chr(34) & "CATIA.Application" & Chr(34) & ")")
sw.WriteLine("Dim partDocument1")
sw.WriteLine("Set partDocument1 = catia.ActiveDocument")
sw.WriteLine("Dim part1")
sw.WriteLine("Set part1 = partDocument1.Part")
sw.WriteLine("Dim hybridShapeFactory1")
sw.WriteLine("Set hybridShapeFactory1 = part1.HybridShapeFactory")
sw.WriteLine("Dim hybridShapeDirection1")
sw.WriteLine("Set hybridShapeDirection1 = hybridShapeFactory1.AddNewDirectionByCoord(1#, 2#, 3#)")
sw.WriteLine("Dim hybridBodies1")
sw.WriteLine("Set hybridBodies1 = part1.HybridBodies")
sw.WriteLine("Dim hybridBody1")
sw.WriteLine("Set hybridBody1 = hybridBodies1.Item(" & Chr(34) & "PointSetx" & Chr(34) & ")")
sw.WriteLine("dim skteches1")
sw.WriteLine("Set sketches1 = hybridBody1.HybridSketches")
sw.WriteLine("Dim sketch1")
sw.WriteLine("Set sketch1 = sketches1.Item(" & Chr(34) & "Sketch.1" & Chr(34) & ")")
sw.WriteLine("Dim reference1")
sw.WriteLine("Set reference1 = part1.CreateReferenceFromObject(sketch1)")
sw.WriteLine("Dim hybridShapeExtremum1")
sw.WriteLine("Set hybridShapeExtremum1 = hybridShapeFactory1.AddNewExtremum(reference1, hybridShapeDirection1, 1)")
sw.WriteLine("hybridBody1.AppendHybridShape hybridShapeExtremum1")
sw.WriteLine("Dim reference2")
Dim lessOneCount As String
Dim spacing As Double = 0
Dim count As String
Dim setString As String
'loop
THIS IS THE PART OF THE CODE THAT IS ADDING EXTRA SPACES
For i = 1 To numbOfPoints Step 1
count = Str(i)
count.Replace(" ", "")
MsgBox(count)
If i < 2 Then
lessOneCount = "hybridShapeExtremum1"
Else
lessOneCount = "HybridShapePointOnCurve" + Str(i - 1)
End If
sw.WriteLine("reference2 = part1.CreateReferenceFromObject(" + lessOneCount + ")")
setString = "Dim hybridShapePointOnCurve" + count
sw.WriteLine(setString)
setString = "hybridShapePointOnCurve" + count + " = hybridShapeFactory1.AddNewPointOnCurveWithReferenceFromDistance(reference1, reference2, spacing, False)"
sw.WriteLine(setString)
setString = "hybridShapePointOnCurve" + count + ".DistanceType = 1"
sw.WriteLine(setString)
setString = "hybridBody1.AppendHybridShape(hybridShapePointOnCurve" + count + ")"
sw.WriteLine(setString)
Next
sw.WriteLine("End Sub")
sw.Flush()
sw.Close()
End If
Sample output:
Dim hybridShapePointOnCurve 2
SHOULD be:
Dim hybridShapePointOnCurve2
What modifications should I make to the way I join strings?
Thanks!
Realized my comment didn't answer your question completely, so a few things:
The String.Replace method doesn't work like you think it does. Saying count.Replace(" ", "") doesn't actually change the variable count; the function actually returns a new string. For it work like you want, you would need to do count = count.Replace(" ", "").
Consider using a StringBuilder instead of concatenating a bunch of strings together. It will greatly improve performance. When using the StringBuilder class, you also wouldn't need to write to the StreamWriter until the very end, simply by calling sw.Write(stringBuilderObject.ToString())
I haven't used VB.NET in a while, but I would check what Str(i) returns. Instead of using VB functions, consider using .NET functions by saying count = i.ToString(). According to Sky, the Str function indeed returns a space because it reserves it for the negative sign. Based on this, I would use the .ToString() method instead.
I spoke to quickly in my comment, the Str function reserves room for the sign, since it is a positive number there is no sign, if it was negative there would be a minus sign there. Try Trim(Str(i)) instead
From above link(emphasis mine):
This example uses the Str function to return a String representation of a number. When a positive number is converted to a string, a leading space is always reserved for its sign.

Propercase function with hypens

I've got a ProperCase function in my .Net code like so
Public Function ProperCase(ByVal strValue As String) As String
Dim outString As String = ""
Dim badWords As String = "and, at, do, de, du, USA, UK"
Dim splitter(1) As Char
splitter(0) = " "
Dim splitString As String() = strValue.Split(splitter)
For Each s As String In splitString
If badWords.Contains(s) Then
outString = outString & s & " "
Else
outString = outString & StrConv(s, VbStrConv.ProperCase) & " "
End If
Next
Return Trim(outString)
End Function
I need to propercase double barrelled names like Taylor-Smith but it's coming out like Taylor-smith because the splitter is a space so I modified the code like so.
Public Function ProperCase(ByVal strValue As String) As String
Dim outString As String = ""
Dim badWords As String = "and, at, do, de, du, USA, UK"
Dim splitter(2) As Char
splitter(0) = " "
splitter(1) = "-"
Dim splitString As String() = strValue.Split(splitter)
For Each s As String In splitString
If badWords.Contains(s) Then
outString = outString & s
Else
outString = outString & StrConv(s, VbStrConv.ProperCase)
End If
Next
Return Trim(outString)
End Function
So I added an extra splitter into the function but now it's not returning the value with the hyphen in. I removed the & " " from the end of the outString but i'm not sure what I can replace it with.
I've tried to add & splitter but it always returns a hyphen even if the splitter was a space.
Currently I'm getting this with my modified code
Mr TomHart
Mr JamieTaylorSmith
And With the first version of the code I got this
Mr Tom Hart
Mr Jamie Taylor-smith
My expected outputs are like so...
Mr Tom Hart
Mr Jamie Taylor-Smith
Any ideas?
I wouldn't alter the split method at all to catch the hyphens. Instead I would look at the outstring. Resulting from your first method before you changed it. Probably in the If inside the loop.
This is a really quick idea to base it on... not necessarily the cleanest version of it but should give you the idea:
Dim outstring As String = "Michael James-smith"
Dim indexOfCharToCheck As Integer = outstring.LastIndexOf("-"c) + 1
Dim finalString As String = outstring.Substring(0, indexOfCharToCheck) & UCase(outstring(indexOfCharToCheck).ToString) & outstring.Substring(indexOfCharToCheck + 1)
MsgBox(finalString)