How can I check if a string starts (or ends) with vbCrLf?
I've tried with substring but it doesn't seem to work:
Dim s As String = ""
s &= vbCrLf & "Test"
If s.Substring(0, 1) = vbCrLf Then
MsgBox("Yes")
End If
Try this
StartsWith - checks the first part of a String.
Dim s As String = "vbCrLf bla bla bla"
If s.StartsWith("vbCrLf") Then
MsgBox("Yes")
End If
EndsWith - checks the last characters of a String.
Dim s As String = "bla bla bla vbCrLf"
If s.EndsWith("vbCrLf") Then
MsgBox("Yes")
End If
Left (and Right) can be used in place of .StartsWith/.EndsWith if you're having issues with these.
Dim s As String
s = vbCrLf & "Test"
If Left(s, Len(vbCrLf)) = vbCrLf Then
MsgBox("Yes")
End If
The simplest solution I could come up with for determining whether a string contains another string anywhere is to use the split function:
Dim s As String
Dim i As Integer
Dim v As Variant
s = vbCrLf & "Test"
i = Split(s, vbCrLf)
For Each item In i
j = j + 1
Next item
If j > 1 or vbCrLf = "" Then
MsgBox("Yes")
End If
I believe you are asking if there is a way to see if the string begins with a line brake. [Line Feed Return] (vbLf) or [Carriage Return] (vbCr). I use the Chr value to do that. Chr(13) is vbCr. Chr(10) is vbLf. You can use Asc to find out what the first Chr of a string is. Something like this;
Dim s As String = vbCr & "bla bla bla"
If Asc(s) = 13 Then
MsgBox("s strats with a Carriage Return")
else If Asc(s) = 10 Then
MsgBox("s strats with a Line Feed Return")
End If
Related
How can I modify my regex so that it will ignore the comments in the pattern in a language that doesn't support lookbehind?
My regex pattern is:
\b{Word}\b(?=([^"\\]*(\\.|"([^"\\]*\\.)*[^"\\]*"))*[^"]*$)
\b{Word}\b : Whole word, {word} is replaced iteratively for the vocab list
(?=([^""\](\.|""([^""\]\.)[^""\]""))[^""]$) : Don't replace anything inside of quotes
My goal is to lint variables and words so that they always have the same case. However I do not want to lint any words in a comment. (The IDE sucks and there is no other option)
Comments in this language are prefixed by an apostrophe. Sample code follows
' This is a comment
This = "Is not" ' but this is
' This is a comment, what is it's value?
Object.value = 1234 ' Set value
value = 123
Basically I want the linter to take the above code and say for the word "value" update it to:
' This is a comment
This = "Is not" ' but this is
' This is a comment, what is it's value?
Object.Value = 1234 ' Set value
Value = 123
So that all code based "Value" are updated but not anything in double quotes or in a comment or part of another word such as valueadded wouldn't be touched.
I've tried several solutions but haven't been able to get it to work.
['.*] : Not preceeding an apostrophy
(?<!\s*') : BackSearch not with any spaces with apoostrophy
(?<!\s*') : Second example seemed incorrect but this won't work as the language doesn't support backsearches
Anybody have any ideas how I can alter my pattern so that I don't edit commented variables
VBA
Sub TestSO()
Dim Code As String
Dim Expected As String
Dim Actual As String
Dim Words As Variant
Code = "item = object.value ' Put item in value" & vbNewLine & _
"some.item <> some.otheritem" & vbNewLine & _
"' This is a comment, what is it's value?" & vbNewLine & _
"Object.value = 1234 ' Set value" & vbNewLine & _
"value = 123" & vbNewLine
Expected = "Item = object.Value ' Put item in value" & vbNewLine & _
"some.Item <> some.otheritem" & vbNewLine & _
"' This is a comment, what is it's value?" & vbNewLine & _
"Object.Value = 1234 ' Set value" & vbNewLine & _
"Value = 123" & vbNewLine
Words = Array("Item", "Value")
Actual = SOLint(Words, Code)
Debug.Print Actual = Expected
Debug.Print "CODE: " & vbNewLine & Code
Debug.Print "Actual: " & vbNewLine & Actual
Debug.Print "Expected: " & vbNewLine & Expected
End Sub
Public Function SOLint(ByVal Words As Variant, ByVal FileContents As String) As String
Const NotInQuotes As String = "(?=([^""\\]*(\\.|""([^""\\]*\\.)*[^""\\]*""))*[^""]*$)"
Dim RegExp As Object
Dim Regex As String
Dim Index As Variant
Set RegExp = CreateObject("VBScript.RegExp")
With RegExp
.Global = True
.IgnoreCase = True
End With
For Each Index In Words
Regex = "[('*)]\b" & Index & "\b" & NotInQuotes
RegExp.Pattern = Regex
FileContents = RegExp.Replace(FileContents, Index)
Next Index
SOLint = FileContents
End Function
As discussed in the comments above:
((?:\".*\")|(?:'.*))|\b(v)(alue)\b
3 Parts to this regex used with alternation.
A non-capturing group for text within double quotes, as we dont need that.
A non-capturing group for text starting with single quote
Finally the string "value" is split into two parts (v) and (value) because while replacing we can use \U($2) to convert v to V and rest as is so \E$3 where \U - converts to upper case and \E - turns off the case.
\b \b - word boundaries are used to avoid any stand-alone text which is not part of setting a value.
https://regex101.com/r/mD9JeR/8
I need to tokenize a mathematical expression using VBA. I have a working solution but am looking for a more efficient way of doing it (possibly RegExp).
My current solution:
Function TokeniseTheString(str As String) As String()
Dim Operators() As String
' Array of Operators:
Operators = Split("+,-,/,*,^,<=,>=,<,>,=", ",")
' add special characters around all "(", ")" and ","
str = Replace(str, "(", Chr(1) & "(" & Chr(1))
str = Replace(str, ")", Chr(1) & ")" & Chr(1))
str = Replace(str, ",", Chr(1) & "," & Chr(1))
Dim i As Long
' add special characters around all operators
For i = LBound(Operators) To UBound(Operators)
str = Replace(str, Operators(i), Chr(1) & Operators(i) & Chr(1))
Next i
' for <= and >=, there will now be two special characters between them instead of being one token
' to change < = back to <=, for example
For i = LBound(Operators) To UBound(Operators)
If Len(Operators(i)) = 2 Then
str = Replace(str, Left(Operators(i), 1) & Chr(1) & Chr(1) & Right(Operators(i), 1), Operators(i))
End If
Next i
' if there was a "(", ")", "," or operator next to each other, there will be two special characters next to each other
Do While InStr(str, Chr(1) & Chr(1)) > 0
str = Replace(str, Chr(1) & Chr(1), Chr(1))
Loop
' Remove special character at the end of the string:
If Right(str, 1) = Chr(1) Then str = Left(str, Len(str) - 1)
TokeniseTheString = Split(str, Chr(1))
End Function
Test using this string IF(TestValue>=0,TestValue,-TestValue) gives me the desired solution.
Sub test()
Dim TokenArray() As String
TokenArray = TokeniseTheString("IF(TestValue>=0,TestValue,-TestValue)")
End Sub
I have never seen regular expressions before and tried to implement this into VBA. The problem I am having is that the RegExp object in VBA doesn't allow positive lookbehind.
I will appreciate any more efficient solution than mine above.
As suggested by #Florent B, the following function gives the same results using RegExp:
Function TokenRegex(str As String) As String()
Dim objRegEx As New RegExp
Dim strPattern As String
strPattern = "(""(?:""""|[^""])*""|[^\s()+\-\/*^<>=,]+|<=|>=|\S)\s*"
With objRegEx
.Global = True
.MultiLine = False
.IgnoreCase = True
.Pattern = strPattern
End With
str = objRegEx.Replace(str, "$1" & ChrW(-1))
If Right(str, 1) = ChrW(-1) Then str = Left(str, Len(str) - 1)
TokenRegex = Split(str, ChrW(-1))
End Function
Can anyone please help me out with Vba macro.
I'm using the below mentioned code. The task is to read a notepad file which contains contents and extract a certain string which looks like "Z012345" and paste them in excel row wise such cell A1 will Z067859 and A2 would be Z002674 etc.,
A sample of how the contents in the notepad file looks like
Contents:
RAF0A123 Full data len= 134
ABATWER01 Recent change by VT0123123 on 11/12/17-11:50
INCLUDE(STELLER Z067859 Z002674 Z004671 Z003450 Z005433 Z023123 Z034564 Z034554 Z043212 Z010456 Z014567
Z027716 Z028778 Z029439 Z029876 Z035766 Z036460 Z038544 Z046456 Z047680 Z052907 Z053145 Z074674 Z094887
VBA code:
Sub Demo()
Dim myFile As String, text As String, textline As String
Dim regex As Object, str As String
Set regex = CreateObject("VBScript.RegExp")
myFile = "C:\Users\sample.txt"
Open myFile For Input As #1
With regex
.Pattern = "Z0[0-9]+"
.Global = Trueq
End With
Set matches = regex.Execute(Input)
For Each Match In matches
Range("A1:A4000").Value = Match.Value
Next Match
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
Close #1
End Sub
Expected output:
Excel output column A should contain the below:
Z067859
Z002674
Z004671
Z003450
Z005433
Z023123
Z034564
Z034554
Z043212
Z010456
Z014567
Z027716
Z028778
Z029439
Z029876
Z035766
Z036460
Z038544
Z046456
Z047680
Z052907
Z053145
Z074674
Z094887
Could anyone help me out to write a macro to perform the task?
Rather than reading one line at a time, I would rather read the entire file into a string and then find the string and paste it. Sample code
Dim myFile As String, regex As Object, str As String, ctr As Long
myFile = "C:\Users\sample.txt"
With CreateObject("Scripting.FileSystemObject")
str = .OpenTextFile(myFile, 1).ReadAll
End With
Set regex = CreateObject("VBScript.RegExp")
With regex
.Pattern = "Z0[0-9]+"
.Global = True
End With
Set matches = regex.Execute(str)
ctr = 1
For Each Match In matches
Sheet1.Range("A" & ctr).Value2 = Match
ctr = ctr + 1
Next Match
I actually think your code is 85% there. I see a couple of things wrong.
1) You need to read the file before you try to output to Excel. In your code it seems you read the file after any activity in Excel
2) You are putting the same value in every single cell from A1 to A1000, overwriting them each time. I believe you want to loop down and put each value in a cell.
3) You're passing a variable that doesn't even exist to your regex
A couple of changes, and this might do it:
Sub Demo()
Dim myFile As String, text As String, textline As String
Dim regex As Object, str As String
Set regex = CreateObject("VBScript.RegExp")
myFile = "C:\Users\sample.txt"
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
Close #1
With regex
.Pattern = "Z0[0-9]+"
.Global = True
End With
Set matches = regex.Execute(text)
Dim row As Long
row = 1
For Each Match In matches
Cells(row, 1).Value2 = Match
row = row + 1
Next Match
End Sub
Please try the below and let me know it meets your requirement
Sub Demo()
Dim myFile As String, text As String, textline As String
Dim str As String
Dim LineArray() As String
Dim DataArray() As String
Dim TempArray() As String
Dim rw As Long, col As Long
Dim FileContent As String
Set regex = CreateObject("vbscript.regexp")
Dim allMatches As Object
Delimiter = " "
myFile = "Path\sample.txt"
With regex
.Pattern = "Z0[0-9]+"
.Global = True
End With
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
LineArray() = Split(text, vbCrLf)
i = 1
For x = LBound(LineArray) To UBound(LineArray)
If Len(Trim(LineArray(x))) <> 0 Then
TempArray = Split(LineArray(x), Delimiter)
col = UBound(TempArray)
ReDim Preserve DataArray(col, rw)
For y = LBound(TempArray) To UBound(TempArray)
Set allMatches = regex.Execute(TempArray(y))
Range("A" & i).Value = allMatches.Item(0)
i = i + 1
Next y
End If
rw = rw + 1
Next x
Close #1
End Sub
Thanks
I try to highlight a word found by RegEx, and if the right to replace it with its corresponding substitute.
The code works correctly only if NOT substituted.
Probably should every time rearrange???
Sub Replace()
Dim regExp As Object
Set regExp = CreateObject("vbscript.regexp")
Dim arr As Variant
Dim arrzam As Variant
Dim i As Long
Dim choice As Integer
Dim Document As Word.Range
Set Document = ActiveDocument.Content
On Error Resume Next
'EGN
'IBAN
arr = VBA.Array("((EGN(:{0,1})){0,1})[0-9]{10}", _
"[a-zA-Z]{2}[0-9]{2}[a-zA-Z0-9]{4}[0-9]{7}([a-zA-Z0-9]?){0,16}")
arrzam = VBA.Array("[****]", _
"[IBAN]")
With regExp
For i = 0 To UBound(arr)
.Pattern = arr(i)
.Global = True
For Each Match In regExp.Execute(Document)
ActiveDocument.Range(Match.FirstIndex, Match.FirstIndex + Match.Length).Duplicate.Select
choice = MsgBox("Replace " & Chr(34) & Match.Value & Chr(34) & " with " & Chr(34) & arrzam(i) & Chr(34) & "?", _
vbYesNoCancel + vbDefaultButton1, "Replace")
If choice = vbYes Then
Document = .Replace(Document, arrzam(i))
ElseIf choice = vbCancel Then
Next
End If
Next
Next
End With
End Sub
Actually, there are several things wrong with this.
First, the each Match in Each Match is static, determined at the moment of the first loop. You're changing the document in the meantime, so each successive Match looks at an old position.
Second, you're replacing all the occurrences at one time, so there is no need to loop through them. It seems a one line, one time Replace could do the same thing.
I parse message data into a CSV file via Outlook rules.
How can I take the example below and store the text under "Customer Log Update:" into a string variable?
[Header Data]
Description: Problem: A2 - MI ERROR - R8036
Customer Log Update:
I'm having trouble with order #458362. I keep getting Error R8036, can you please assist?
Thanks!
View problem at http://...
[Footer Data]
Desired result to be stored into the string variable (note that the result may contain newlines):
I'm having trouble with order #458362. I keep getting Error R8036, can you please assist?
Thanks!
I haven't attempted to code anything pertaining to my question.
Function RegFind(RegInput, RegPattern)
Dim regEx As New VBScript_RegExp_55.RegExp
Dim matches, s
regEx.Pattern = RegPattern
regEx.IgnoreCase = True
regEx.Global = False
s = ""
If regEx.Test(RegInput) Then
Set matches = regEx.Execute(RegInput)
For Each Match In matches
s = Match.Value
Next
RegFind = s
Else
RegFind = ""
End If
End Function
Sub CustomMailMessageRule(Item As Outlook.MailItem)
MsgBox "Mail message arrived: " & Item.Subject
Const FileWrite = file.csv `file destination
Dim FF1 As Integer
Dim subj As String
Dim bod As String
On Error GoTo erh
subj = Item.Subject
'this gets a 15 digit number from the subject line
subj = RegFind(subj, "\d{15}")
bod = Item.Body
'following line helps formatting, lots of double newlines in my source data
bod = Replace(bod, vbCrLf & vbCrLf, vbCrLf)
'WRITE FILE
FF1 = FreeFile
Open FileWrite For Append As #FF1
Print #FF1, subj & "," & bod
Close #FF1
Exit Sub
erh:
MsgBox Err.Description, vbCritical, Err.Number
End Sub
While I would also go the more direct route like Jean-François Corbett did as the parsing is very simple, you could apply the Regexp approach as below
The pattern
Update:([\S\s]+)view
says match all characters between "Update" and "view" and return them as a submatch
This piece [\S\s] says match all non-whitespace or whitespace characters - ie everything.
In vbscript a . matches everything but a newline, hence the need for the [\S\s] workaround for this application
The submatch is then extracted by
objRegM(0).submatches(0)
Function ExtractText(strIn As String)
Dim objRegex As Object
Dim objRegM As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.ignorecase = True
.Pattern = "Update:([\S\s]+)view"
If .test(strIn) Then
Set objRegM = .Execute(strIn)
ExtractText = objRegM(0).submatches(0)
Else
ExtractText = "No match"
End If
End With
End Function
Sub JCFtest()
Dim messageBody As String
Dim result As String
messageBody = "Description: Problem: A2 - MI ERROR - R8036" & vbCrLf & _
"Customer Log Update:" & _
"I 'm having trouble with order #458362. I keep getting Error R8036, can you please assist?" & vbCrLf & _
"Thanks!" & vbCrLf & _
"View problem at http://..."
MsgBox ExtractText(messageBody)
End Sub
Why not something simple like this:
Function GetCustomerLogUpdate(messageBody As String) As String
Const sStart As String = "Customer Log Update:"
Const sEnd As String = "View problem at"
Dim iStart As Long
Dim iEnd As Long
iStart = InStr(messageBody, sStart) + Len(sStart)
iEnd = InStr(messageBody, sEnd)
GetCustomerLogUpdate = Mid(messageBody, iStart, iEnd - iStart)
End Function
I tested it using this code and it worked:
Dim messageBody As String
Dim result As String
messageBody = "Description: Problem: A2 - MI ERROR - R8036" & vbCrLf & _
"Customer Log Update:" & vbCrLf & _
"I 'm having trouble with order #458362. I keep getting Error R8036, can you please assist?" & vbCrLf & _
"Thanks!" & vbCrLf & _
"View problem at http://..."
result = GetCustomerLogUpdate(messageBody)
Debug.Print result