Trim (in VBA for MS-Access 2010) does not remove vbCrLfs, only spaces. In the immediate window, I get
? Len(vbCrLf & "a" & vbCrLf & "b" & vbCrLf)
8
? Len(Trim(vbCrLf & "a" & vbCrLf & "b" & vbCrLf))
8
For spaces however:
? Len(" " & "a" & " " & "b" & " ")
5
? Len(Trim(" " & "a" & " " & "b" & " "))
3
How to make a trim that removes vbCrLFs on the ends only?
If you don't mind removing ALL new lines (and not just edges) you could just do:
myStr = Application.clean(Application.trim(myStr))
For imitating Trim function, you'd need to test each character in your string's edges:
Function TrimNewLines(mtStr As String) As String
Dim pattern As String, c As String
Dim i As Integer: i = 1
pattern = "[" & Chr(10) & Chr(13) & "]"
c = Mid(mtStr, i, 1)
Do While c Like pattern
i = i + 1
c = Mid(mtStr, i, 1)
Loop
mtStr = Mid(mtStr, i, Len(mtStr))
i = Len(mtStr)
c = Mid(mtStr, i, 1)
Do While c Like pattern
i = i - 1
c = Mid(mtStr, i, 1)
Loop
mtStr = Mid(mtStr, 1, i)
TrimNewLines = mtStr
End Function
This seems to have done the trick:
Public Function trimNewlinesAndSpaces(chaine As String) As String
chaine = Trim(chaine)
Do While (left(chaine, 2) = vbCrLf) Or right(chaine, 2) = vbCrLf
If left(chaine, 2) = vbCrLf Then
chaine = right(chaine, Len(chaine) - 2)
End Ifj
If right(chaine, 2) = vbCrLf Then
chaine = left(chaine, Len(chaine) - 2)
End If
chaine = Trim(chaine)
Loop
trimNewlinesAndSpaces = chaine
End Function
Related
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
I am trying to break up the full name of two Recipients to get the first names.
Here is the code:
For r = 1 To .recipients.Count
Debug.Print .recipients(r)
strgreetname = Left(.recipients(r), InStr(1, .recipients(r), " ") - 1)
strTo = Left(strGreetNameAll, InStr(1, .recipients(r), " ") - 2)
strGreetNameAll = strGreetNameAll & strgreetname & ", "
strgreetnameall1 = strgreetname
Next r
For i = 1 To .recipients.Count
Debug.Print .recipients(i)
strgreetname = Left(.recipients(i), InStr(1, .recipients(i), " ") - 1)
strTo1 = Right(strTo, InStr(1, .recipients(i), " ") - 2)
strGreetNameAll = strGreetNameAll & strgreetname & ", "
strgreetnameall1 = strgreetname
Next i
I cannot get strTo and strTo1 to work separately based on the recipients count. It seems to only change if I change the first defined item, in this case r. Changing the i value does nothing. It seems that the first defined variable controls everything below it, even though I have it set separately. How do I break these up so that r controls one section, while i controls another, so they work autonomously?
Update--I got it to separate but the first alias (strTO) is cutting off in strange ways. I want to cut off at the first space in the alias, which I thought I did with the "left" piece. However, it is not consistent, cutting off long names, or pulling in parts of the next name if the first alias was a short name (like Tom).
For R = 1 To .recipients.Count
Debug.Print .recipients(R)
strgreetname = Left(.recipients(R), InStr(1, .recipients(R), " "))
strgreetname2 = Left(.recipients(2), InStr(1, .recipients(R), " "))
strGreetNameAll = strGreetNameAll & strgreetname
strGreetNameAll1 = strgreetname
strTo = Left(strGreetNameAll, InStr(1, .recipients(R), " "))
strTo1 = Left(strgreetname2, InStr(1, .recipients(R), " "))
Next R
StrTO and strTO1 are the first and second aliases in the To field, respectively.
For example:
Given .Recipients "William Hartnell", "Carole Ann Ford", "Patrick Troughton", "Anneke Wills", "Jon Pertwee", and "Tom Baker".
I want strTO to be William. I want strTO1 to be Carole. So it could be Dear William and Carole.
Based on your comment that you want strTO to be all characters up to the first space in .Recipients(1), and you want strTO1 to be all characters up to the first space in .Recipients(2), then you can use the following code:
strTO = Left(.Recipients(1), InStr(.Recipients(1) & " ", " ") - 1)
If .Recipients.Count > 1 Then
strTO1 = Left(.Recipients(2), InStr(.Recipients(2) & " ", " ") - 1)
Else
strTO1 = ""
End If
And, if you were using this to create a "greeting", you could just use something like:
strGreetName = Left(.Recipients(1), InStr(.Recipients(1) & " ", " ") - 1)
If .Recipients.Count > 1 Then
strGreetName = strGreetName & " and " & Left(.Recipients(2), InStr(.Recipients(2) & " ", " ") - 1)
End If
and not worry about having strTO and strTO1.
Or, if you wanted to include all the names, you could use something like
strGreetName = ""
For i = 1 to .Recipients.Count
If i > 1 Then
If i = .Recipients.Count Then
strGreetName = strGreetName & " and "
Else
strGreetName = strGreetName & ", "
End If
End If
strGreetName = strGreetName & Left(.Recipients(i), InStr(.Recipients(i) & " ", " ") - 1)
Next
you are doing this
for r = 1 to 10
a = r + 4
next r
for i = 1 to 10
b = a + 2
next r
when you want
for r = 1 to 10
a = r + 4
b = a + 2
next r
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
A common usage of VBA at my company is generation of source code based on information entered in Excel tables. Given VBA's native string manipulation, the code that does this is tedious to write and not very readable.
A simple example (these get more complex) is:
Print #fileIdentifier, SSpace(9) & "update_" & print_string & "[" & CStr(j) & "] <= 1'b0;"
Print #fileIdentifier, SSpace(9) & print_string & "_ack_meta" & "[" & CStr(j) & "] <= 1'b0;"
Print #fileIdentifier, SSpace(9) & print_string & "_ack_sync" & "[" & CStr(j) & "] <= 1'b0;"
I am looking for a solution in VBA that would allow me to specify this using a "text template", so define a text that would look something like this
update_#name#[#bit#] <= 1'b0;
#name#_ack_meta[#bit#] <= 1'b0;
#name#_ack_sync[#bit#] <= 1'b0;
and have a function/method call, passing the values of #name# and #bit#, replace all instances of #name# and #bit# with corresponding values.
Basic insertion function:
Function insert(template As String, ParamArray inserts() As Variant) As String
Dim i As Long
For i = 0 To UBound(inserts)
template = Replace$(template, "%" & i + 1 & "%", inserts(i))
Next
'// some special cases perhaps
template = Replace$(template, "%SSPACE%", SSpace(9))
template = Replace$(template, "\r\n", VbCrLf)
insert = template
End Function
For
?insert("Foo %1% Bar %2% Qux %3% (%1%)", "A", "B", "C")
Foo A Bar B Qux C (A)
Map (add a reference to Microsoft Scripting Runtime):
Dim col As New Scripting.Dictionary
col("name") = "bob"
col("age") = 35
MsgBox insert2("Hello %name% you are %age%", col)
...
Function insert2(template As String, map As Scripting.Dictionary) As String
Dim name
For Each name In map.Keys()
template = Replace$(template, "%" & name & "%", map(name))
Next
insert2 = template
End Function
Alex K., thank you for the solution.
Here is how I expanded it (please feel free to let me know if there is a better way of doing this)
Function FillTemplateGeneric(template As Variant, map As Scripting.Dictionary) As String
Dim name
Dim out_text As String
' Handle multiple ways of receiving the template string
If VarType(template) = vbString Then
out_text = template
ElseIf VarType(template) = vbArray Then
out_text = Join(template, vbCrLf)
ElseIf TypeName(template) = "String()" Then
out_text = Join(template, vbCrLf)
ElseIf TypeName(template) = "Variant()" And TypeName(template(LBound(template, 1))) = "String" Then
out_text = Join(template, vbCrLf)
Else
MsgBox "Unknown Var Type passed to FillTemplateGeneric as first argument:" & vbCrLf & TypeName(template)
Err.Raise vbObjectError + 513, "FillTemplateGeneric", "Unknown Var Type passed to FillTemplateGeneric as first argument:" & vbCrLf & TypeName(template)
End If
For Each name In map.Keys()
out_text = Replace$(out_text, "%" & name & "%", map(name))
Next
FillTemplateGeneric = out_text
End Function
This allows for it to accept calls in multiple formats:
' Common dictionary for expansion
Dim col As New Scripting.Dictionary
col("name") = print_string
' Using inline text for template
MsgBox FillTemplateGeneric("test text with %name% name - just string", col)
' Using a multi-line string
Dim template As String
templ_text = " update_%name% <= 1'b0; // 1 - manual multi-line string" & _
vbCrLf & " %name%_ack_meta <= 1'b0; // " & _
vbCrLf & " %name%_ack_sync <= 1'b0; // "
MsgBox FillTemplateGeneric(templ_text, col)
' Using an array of strings
Dim ttext(1 To 3) As String
ttext(1) = " update_%name% <= 1'b0; // 2 - manual array of strings"
ttext(2) = " %name%_ack_meta <= 1'b0; // "
ttext(3) = " %name%_ack_sync <= 1'b0; // "
MsgBox FillTemplateGeneric(ttext, col)
' Using an inline array of strings
MsgBox FillTemplateGeneric(Array( _
" update_%name% <= 1'b0; // 3 - immediate array of strings", _
" %name%_ack_meta <= 1'b0; // ", _
" %name%_ack_sync <= 1'b0; // " _
), col)
dasaset (ds) contain value like this comapring two dataset and write the phone number from dataset to notepad which is not equal to dataset1.but am getting the result in notepad like the phone numbers which are equal to both dataset
dataset
-------
91 9942321400
91 9865015695
91 9677031515
91 9994828285
91 9688104229
dataset1 values
----------------
91 9942321400
91 9865015695
91 9677031515
expected result in notepad
--------------------------
91 9994828285
91 9688104229
my code
-------
Dim i As Integer = 0
Dim toggle As Boolean = False
Do While (i <= ds1.Tables(0).Rows.Count - 1)
Dim phone As String = ds1.Tables(0).Rows(i).Item(1).ToString
Dim j As Integer = 0
Do While (j <= Ds.Tables(0).Rows.Count - 1)
Dim dumphone As String = Ds.Tables(0).Rows(j).Item(4).ToString
If dumphone <> phone Then toggle = True 'This will set your flag to add the output.
j = (j + 1)
Loop
'After we're done checking if there's a match, we decided to add it to the output.
If toggle = True Then
TextBox1.AppendText(a.ToString & "|" & b.ToString & "|" & c.ToString & "|" & d.ToString & "|" & phone.ToString & "|" & e1.ToString & "|" & f.ToString & "|" & g.ToString & "|" & h.ToString & "|" & i1.ToString & "|" & j1.ToString & "|" & k.ToString & "|" & l.ToString & "|" & m.ToString & "|" & n1.ToString & "|" & o.ToString & "|" & p.ToString & "|" & q.ToString & "|" & r.ToString & "|" & s.ToString & "|" & t.ToString & "|" & u.ToString & "|" & v.ToString & "|" & w.ToString & "|" & x.ToString)
sw.WriteLine(TextBox1.Text)
TextBox1.Text = ""
toggle = False 'Reset the flag for the next value
End If
i = (i + 1) 'Move to the next value to check against.
Loop
but am getting the output in note pad like this
------------------------------------------------
91 9942321400
91 9865015695
91 9677031515
I tried this way and I got the result you were looking for...
For i As Integer = 0 To dataset.Tables(0).Rows.Count - 1
Dim found As Boolean = False
For j As Integer = 0 To dataset1.Tables(0).Rows.Count - 1
If dataset.Tables(0).Rows(i)(0).ToString = dataset1.Tables(0).Rows(j) (0).ToString Then
found = True
End If
Next
If found = False Then
'here you are getting the right result in each loop
'in this example i'm showing the result in a textbox
'just change the instruction and write them in your note pad or wherever you want to
MsgBox(dataset.Tables(0).Rows(i)(0).ToString)
End If
Next