VBScript RegEx group match with back reference issue - regex

I have a line in my web.config which is as follows
<clientDependency loggerType="xxx.ClientDependencies.Logger,StrattonWebShared" version="144">
What I am trying to do is write a script which checks my code base for modifications and then updates the clientDependency module version by 1 if any found. So the code bit to increase the version by one is as follows
Set clientDepRegExp = new RegExp
clientDepRegExp.IgnoreCase = True
clientDepRegExp.Global = True
clientDepRegExp.Pattern = "(<clientDependency.*version=\"")(\d+)(\"".*)"
'1 = open file for reading
Set clientDependencyConfigFile = fileSystemObject.OpenTextFile(targetFile, 1)
fileContents = clientDependencyConfigFile.ReadAll
clientDependencyConfigFile.Close
fileContents = clientDepRegExp.Replace(fileContents, "$1" & CInt("$2") + 1 & "$3")
My problem is with the last line. $2 is the version number and doing CInt("$2") + 1 is just giving me 3 (so 2 + 1 that is). If I just use "$2" then its returning 144 (refer to the first line for version number). SO my question is if I wana do a quick arithmatic inside replace how should I do it?
Thanks in advance for any tips ans suggestions that you can provide

Change your code something like that:
Set clientDepRegExp = New RegExp
Set fso = New Scripting.FileSystemObject
With clientDepRegExp
.IgnoreCase = True
.Global = True
.Pattern = "(<clientDependency[^<>]*?version="")(\d+)\b"
fileContents = fso.OpenTextFile(targetFile).ReadAll
tmp = .Replace(reftext, "$2")
fileContents = .Replace(reftext, "$1" & CStr(Val(tmp) + 1))
End With
Hope this work.

Related

Need to capture patterns and replace code in file VBScripts

The code in file abc is which needs to captured with Regex.
With TeWindow("tewindow").Tescreen("something").TeField("some")
.set "value"
.setToProperty "V"
.exist(0)
End With
This code should be replaced in abc with
'With TeWindow("tewindow").Tescreen("something").TeField("some")
myset("something_some"), "value"
mysetToProperty("something_some"), ""
myExist("something_some"), (0)
'End With
Following is the trial so far. I'm not able to make it to writing in the file.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set testfile = objFSO.OpenTextFile("D:\test\testout4.txt", 1, True)
line = testfile.ReadAll
testfile.Close
sString = line
pat = "with[\s]{1,}tewindow\((.*?)\).tescreen\((.*?)\).tefield\((.*?)\)" '12
pat1 = "^\.[a-zA-Z]{1,}"
Call DeclareRegEx(objRE,pat)
If objRE.test(sString) Then
Set Matches = objRE.Execute(sString)
Set match = Matches(0)
intcount = match.SubMatches.Count
If intcount > 0 Then
For I = 1 To intcount-1
'If i = intcount-1 Then
objRef = objRef & match.SubMatches(I)
Next
Else '30
objRef = objRef & match.SubMatches(I) & "_"
End If
End If
call DeclareRegEx(objRE1, pat1)
If objRE1.Test(sString) Then
Set Matches1 = objRE1.Execute(sString)
For Each Match1 in Matches1
RetStr1 = Match1.Value
strplc = Right(RetStr1, Len(RetStr1) - 1)
actual = objRE1.Replace(RetStr1, "my" & strplc & "(" & objRef & ")")
MsgBox actual
Next
End If
Function DeclareRegEx(obj, pattern)
Set obj = New RegExp
obj.Global = True
obj.Multiline = True
obj.Pattern = pattern
obj.IgnoreCase = True
End Function
Suggestion for some other approach or regex is welcome.
well as the approach of finding the block , being captured by verbose regex is not seemed to be a generic in the code i tried something like the following..
take the file content into an array
2.find the line no of with and end with
3.run a loop to iterate the functions from the next line of the with till line before the end with.
it worked for me !

Check input for UCase (RegEx) and convert in UCase if LCase

I'm having the following script:
Function IsValidLetter( Letter )
const IVNAME_TEST = "[A-Z]{1,2}"
Dim regEx, match, myMatches
Set regEx = New RegExp
regEx.Pattern = IVNAME_TEST
regex.IgnoreCase = false
Set myMatches = regEx.Execute( UCase(Letter) )
If myMatches.Count > 0 Then
IsValidLetter = true
End If
End function
It works great, because I want maximum 2 letter from A-Z in an input field. My question; how do I check if the input is lower or uppercase? Best solution would be if it converts it 'on the fly' with this function.
PS: 'Letter' is an input value from a HTML file.
UPDATE:
Sub SetFullName
UppercaseConvert.Value = Letter.Value
CombinedName.Value = Ucase(CombinedName.Value)
End Sub
Works great! :)
Alternatively you could have:
set regex.IgnoreCase = true
or
set IVNAME_TEST = "[A-Za-z]{1,2}"

Using VBA regex on Array

I am writing a macro and the macro works fine, but I am trying to add some error handling to it so others are using it and an error occurs they are able to figure out what happened. The last problem I am having is I am using the Application.GetOpenFilename to open multiple files with multiselect = True. I am using a regex to match the file name and if the wrong file name is chosen then it displays an error message. If multiselect = False then I get no errors, but when it is equal to True I get a Type Mismatch error. I can only assume this is because when mutliselect = True the file is an array which the regex cannot handle. Is there a solution to this or can anyone point me to a better solution to handle the error. I have attached the VBA script as well.
Sub DataImport_Loop()
Dim nom As String
Dim wb As Excel.Workbook
Dim i, j, k, m, n, file As Variant
Dim strPattern As String: strPattern = "Strain End Point [0-9] - FEA Loop - Loading - (Timed)" 'File Pattern
Dim regex As Object
Set regex = CreateObject("VBScript.RegExp")
'Turns Screen Updating and Alert Displays off
Application.ScreenUpdating = False
Application.DisplayAlerts = False
nom = ActiveWorkbook.Name
'takes user straight into necessary folder
If CurDir() <> CurDir("J:") Then
ChDrive "J:"
ChDir "J:FEA Material Data"
End If
'Number of specimens tested
For i = 1 To 5
'Allows user to select multiple files to open
file = Application.GetOpenFilename( _
FileFilter:="Text Files (*.csv), *.csv", _
MultiSelect:=True)
'If no file selected, stop data import and display error message
If Not IsArray(file) Then
MsgBox ("You only imported " & (i - 1) & " Specimens.")
Exit Sub
'Sets patteren to check if correct file
With regex
.Pattern = strPattern
End With
'Checks set pattern, displays error message if not correct file
If regex.Test(file) = False Then
MsgBox ("Select Loading Only")
Exit Sub
End If
Else
Counter = 1
While Counter <= UBound(file)
j = (2 * i) - 1
Workbooks.Open file(Counter)
Set wb = Workbooks("Strain End Point " & Counter & " - FEA Loop - Loading - (Timed).csv")
'End of column, needs + 3 to account for first 3 unused cells
k = Range("F4", Range("F4").End(xlDown)).Count + 3
'Loops through data, deletes negative values
For m = 4 To k
If Range("F" & m).value < 0 Or Range("F" & m).Offset(0, 1) < 0 Then
Range("F" & m).Delete
Range("F" & m).Offset(0, 1).Delete
'If cell is deleted, rechecks new value
m = m - 1
End If
Next m
Range("F4:G" & k).Copy
Workbooks(nom).Sheets(Counter + 1).Cells(4, j).PasteSpecial
wb.Close
'Opens next file
Counter = Counter + 1
Wend
End If
Next i
'Turns Screen Updating and Alert Displays back on
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
When MultiSelect is true, file will always be a variant array, even if only a single file is selected. Therefore you must iterate through each element of the array in order to check it against your mask.
With regard to your mask, I would suggest using the Like operator as it seems simpler and will probably run faster. Note the # replacing the regex pattern [0-9]) eg:
'Checks set pattern, displays error message if not correct file
Const strPattern as String = "Strain End Point # - FEA Loop - Loading - (Timed)" 'File Pattern
For I = LBound(file) To UBound(file)
If Not file(I) Like strPattern Then
MsgBox ("Select Loading Only")
Exit Sub
End If
Next I

How do I get my regex to ignore decimal-separator if it is not followed by a number?

I am trying to come up with a function to capture a number from a string. What I came up with on my own is currently used in this code:
Function ArrayOfCleanedString(strIn As String) As Variant
Dim objRegex As Object, objAllMatches As Object, sAllMatches() As String, v As Variant, i As Long
Set objRegex = CreateObject("vbscript.regexp")
objRegex.Global = True
objRegex.IgnoreCase = False
'objRegex.Pattern = "^(?:(?i)(?:[+-]?)(?:(?=[0123456789]|[.])(?:[0123456789]*)(?:(?:[.])(?:[0123456789]{0,}))?)(?:(?:[E])(?:(?:[+-]?)(?:[0123456789]+))|))$"
'objRegex.Pattern = "^-?(?:(?:0|[1-9][0-9]*)(?:,[0-9]+)?|[1-9][0-9]{1,2}(?:,[0-9]{3})+)$"
objRegex.Pattern = "\-?\d+[" & Application.DecimalSeparator & "\.]?\d*"
Set objAllMatches = objRegex.Execute(strIn)
If objAllMatches.Count <> 0 Then
ReDim sAllMatches(1 To objAllMatches.Count)
For Each v In objAllMatches
i = i + 1
sAllMatches(i) = v
Next
ArrayOfCleanedString = sAllMatches
Else
ArrayOfCleanedString = Array()
End If
End Function
Sub test()
Dim v As Variant, v2 As Variant
v2 = ArrayOfCleanedString("1abc-10.1-1abx1,1o1.")
'v2 = ArrayOfCleanedString("")
If Not IsArrayEmpty(v2) Then
For Each v In v2
Debug.Print CStr(v)
Next
End If
End Sub
This code does however have a problem in that it captures a punctuation / comma at the end of the number, even if there are no digits after it.
I did some searching, and found the two other patterns I've tried in this post, but as you can probably guess they didn't work in VBA :)
I'd try modifying them, but considering that I don't really understand them that is somewhat tricky.
So what I am asking is; is there any simple way to strip the punctuation mark / comma from the end of the match, if it isn't followed by a number?
Alternately, is there any way to translate any of the other two patterns to VBA's brand of regex?
Is there any other obvious flaws in my method? I am quite new to this, so I do a lot of trial and error :P
Oh, and in case any of you wonder about the isEmptyArray method in my code, it is copied from Chip Pearson's page of functions for VBA-arrays.
You can use the posted regex and simply remove trailing "." from elements of the array before returning the array:
Function ArrayOfCleanedString(strIn As String) As Variant
Dim objRegex As Object, objAllMatches As Object, sAllMatches() As String, v As Variant, i As Long
Set objRegex = CreateObject("vbscript.regexp")
objRegex.Global = True
objRegex.IgnoreCase = False
'objRegex.Pattern = "^(?:(?i)(?:[+-]?)(?:(?=[0123456789]|[.])(?:[0123456789]*)(?:(?:[.])(?:[0123456789]{0,}))?)(?:(?:[E])(?:(?:[+-]?)(?:[0123456789]+))|))$"
'objRegex.Pattern = "^-?(?:(?:0|[1-9][0-9]*)(?:,[0-9]+)?|[1-9][0-9]{1,2}(?:,[0-9]{3})+)$"
objRegex.Pattern = "\-?\d+[" & Application.DecimalSeparator & "\.]?\d*"
Set objAllMatches = objRegex.Execute(strIn)
If objAllMatches.Count <> 0 Then
ReDim sAllMatches(1 To objAllMatches.Count)
For Each v In objAllMatches
i = i + 1
sAllMatches(i) = v
If Right(sAllMatches(i), 1) = "." Then
sAllMatches(i) = Left(sAllMatches(i), Len(sAllMatches(i)) - 1)
End If
Next
ArrayOfCleanedString = sAllMatches
Else
ArrayOfCleanedString = Array()
End If
End Function

Using regexp in Excel can I perform some arithmetic on the matched pattern before replacing the matched string?

I am using `VBscript.RegExp`` to find and replace using a regular expression. I'm trying to do something like this:
Dim regEx
Set regEx = CreateObject("VBScript.RegExp")
regEx.Pattern = "ID_(\d{3})"
regEx.IgnoreCase = False
regEx.Global = True
regEx.Replace(a_cell.Value, "=HYPERLINK(A" & CStr(CInt("$1") + 2) )
I.e. I have cells which contain things like ID_006 and I want to replace the contents of such a cell with a hyperlink to cell A8. So I match the three digits, and then want to add 2 to those digits to get the correct row to hyperlink to.
But the CStr(CInt("$1") + 2) part doesn't work. Any suggestions on how I can make it work?
Ive posted given these points
you should test for a valid match before trying a replace
from your current code the Global is redundant as you can add 1 hyerplink (1 match) to a cell
your current code will accept a partial string match, if you wanted to avoid ID_9999 then you match the entire string using ^ and $. This version runs me, you can revert to your current pattern with .Pattern = "ID_(\d{3})"
Normally when adding a hyperlink a visible address is needed. The code beloe does this (with the row manipulation in one shot)
The code below runs at A1:A10 (sample shown dumping to B1:B10 for pre and post coede)
Sub ParseIt()
Dim rng1 As Range
Dim rng2 As Range
Dim regEx
Set rng1 = Range([a1], [a10])
Set regEx = CreateObject("VBScript.RegExp")
With regEx
'match entire string
.Pattern = "^ID_(\d{3})$"
'match anywhere
' .Pattern = "ID_(\d{3})"
.IgnoreCase = False
For Each rng2 In rng1
If .test(rng2.Value) Then
'use Anchor:=rng2.Offset(0, 1) to dump one column to the right)
ActiveSheet.Hyperlinks.Add Anchor:=rng2, Address:="", SubAddress:= _
Cells(.Replace(rng2.Value, "$1") + 2, rng2.Column).Address, TextToDisplay:=Cells(.Replace(rng2.Value, "$1") + 2, rng2.Column).Address
End If
Next
End With
End Sub
This is because: "=HYPERLINK(A" & CStr(CInt("$1") + 2) is evaluated once, when the code is executed, not once for every match.
You need to capture & process the match like this;
a_cell_Value = "*ID_006*"
Set matches = regEx.Execute(a_cell_Value)
Debug.Print "=HYPERLINK(A" & CLng(matches(0).SubMatches(0)) + 2 & ")"
>> =HYPERLINK(A8)
Or if they are all in ??_NUM format;
a_cell_Value = "ID_11"
?"=HYPERLINK(A" & (2 + val(mid$(a_cell_Value, instr(a_cell_Value,"_") +1))) & ")"
=HYPERLINK(A13)
The line -
regEx.Replace(a_cell.Value, "=HYPERLINK(A" & CStr(CInt("$1") + 2) )
won't work as VBA will try to do a CInt on the literal string "$1" rather than on the match from your RegEx.
It would work if you did your replace in 2 steps, something like this -
Dim a_cell
a_cell = Sheets(1).Cells(1, 1)
Dim regEx
Set regEx = CreateObject("VBScript.RegExp")
regEx.Pattern = "ID_(\d{3})"
regEx.IgnoreCase = False
regEx.Global = True
a_cell = regEx.Replace(a_cell, "$1")
Sheets(1).Cells(1, 1) = "=HYPERLINK(A" & CStr(CInt(a_cell) + 2) & ")"