I am working on a vba macro which uses regular expression to search for a string pattern in another string.
Regex pattern includes a string (APR24 in code below) which varies. I need to know how to include a variable in the pattern.Could any one please help.
My code is as below
Public Function Regexsrch(ByVal str2bsrchd As String, ByVal str2srch As String) As Boolean
Dim Regex As New VBScript_RegExp_55.RegExp
Dim matches, s
Regex.Pattern = "(\.|\s)APR24(,|\s|\()"
Regex.IgnoreCase = True
If Regex.Test(str2bsrchd) Then
Regexsrch = True
Else
Regexsrch = False
End If
End Function
So str2srch is "APR24" or some variation? If that is the case you just use concatenation to build up your pattern string.
Public Function Regexsrch(ByVal str2bsrchd As String, ByVal str2srch As String) As Boolean
Dim Regex As New VBScript_RegExp_55.RegExp
Dim matches, s
Regex.Pattern = "(\.|\s)" + str2srch + "(,|\s|\()"
Regex.IgnoreCase = True
If Regex.Test(str2bsrchd) Then
Regexsrch = True
Else
Regexsrch = False
End If
End Function
You can specify whatever pattern you want in str2srch and then assign that to Regex.Pattern
For example
Sub Sample()
Debug.Print Regexsrch("APR24ddd", "APR24") '<~~ Returns True
Debug.Print Regexsrch("APR277ddd", "APR24") '<~~ Returns False
End Sub
Public Function Regexsrch(ByVal str2bsrchd As String, ByVal str2srch As String) As Boolean
Dim Regex As New VBScript_RegExp_55.RegExp
Dim matches, s
Regex.Pattern = str2srch
Regex.IgnoreCase = True
If Regex.Test(str2bsrchd) Then
Regexsrch = True
Else
Regexsrch = False
End If
End Function
FOLLOWUP
Even if it is dynamic you can always pass the pattern as
Debug.Print Regexsrch("APR24ddd", "(\.|\s)" & VARIABLE & "(,|\s|\()").
This gives you the flexibility of using whatever pattern you want to pass to the function and you are not limited to one pattern...
Related
I'm using the following VBA code from a related question in my Excel spreadsheet, and when I use it in a cell, it always fails (returns nothing). Even if I call it on a string literal in the function call (i.e. =RegexExtract("ABC1_DEF","ABC[0-9]")), it still fails. I've enabled the "Microsoft Visual Basic Regular Expressions 5.0" feature in the MSVBA application, so I'm not sure why these results are always empty. How can I resolve this?
Function RegexExtract(ByVal text As String, _
ByVal extract_what As String, _
Optional separator As String = ", ") As String
Dim allMatches As Object
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
Dim i As Long, j As Long
Dim result As String
RE.pattern = extract_what
RE.Global = True
Set allMatches = RE.Execute(text)
For i = 0 To allMatches.count - 1
For j = 0 To allMatches.Item(i).submatches.count - 1
result = result & (separator & allMatches.Item(i).submatches.Item(j))
Next
Next
If Len(result) <> 0 Then
result = Right$(result, Len(result) - Len(separator))
End If
RegexExtract = result
End Function
Edit
I tried yet another function from a separate question, and it just returns #VALUE!:
Function RegexExtract(ByVal text As String, _
ByVal extract_what As String) As String
Dim allMatches As Object
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = extract_what
RE.Global = True
Set allMatches = RE.Execute(text)
RegexExtract = allMatches.Item(0).submatches.Item(0)
End Function
Note you are trying to access .Submatches that stores capturing group values, but you have not defined any capturing groups in the pattern.
If you use (ABC[0-9]) you will get your match with the current function. Else, access the allMatches.Item(i) for full match values and discard the code to get the captured groups.
I know this will be some stupid thing I overlooked, but I swear I have no clue what is wrong with this code:
Public Sub sustituirExpresion(ByVal Exp As String, ByVal Str As String, ByVal cell As String, ByVal hoja As String)
Dim strPattern As String: strPattern = Exp
Dim strReplace As String: strReplace = Str
Dim regEx As New RegExp
Dim strInput As String
Dim Myrange As Range
Set Myrange = Sheets(hoja).Range(cell)
If strPattern <> "" Then
strInput = Myrange.Value
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
sustituirExpresion = (regEx.Replace(strInput, strReplace))
End If
End Sub
Sub limpiarDescripcion()
Dim resultado As String
resultado = sustituirExpresion "/s+", " ", "AD2", "Hoja1"
MsgBox resultado
End Sub
I tried to use the Call form too:
resultado = Call sustituirExpresion ("/s+", " ", "AD2", "Hoja1")
But it still throw me an error "Expected function or varibale" and I can't understand why.
¿Any leads?
Thanks for your time.
There are several things here:
Replace the signature with Public Function sustituirExpresion(ByVal Exp As String, ByVal Str As String, ByVal cell As String, ByVal hoja As String) As String to turn a Sub to a Function
You do not need .MultiLine = True, keep it False because your regex /\s+ does not contain any ^ or $ to re-define the behavior of (they will match start/end of line if you set Multiline to True).
You do not need the parentheses around the regEx.Replace(strInput, strReplace), use sustituirExpresion = regEx.Replace(strInput, strReplace)
I am having a heck of a time with a RegEx question in Access VBA.
My goal is to extract the server from a linked database connection string. Basically, the connection string looks like
ODBC;DRIVER=SQL Server;SERVER=compName\sqlexpress;Trusted_Connection=Yes;APP=Microsoft Office 2010;DATABASE=databaseName
I am able to get the first regex to work, but it is returning
SERVER=compName\sqlexpress
I would like this to only return
compName\sqlexpress
My understanding is the ?<= operator should allow the RegEx to work correctly, but I get the following error "Method 'Execute' of object 'IRegExp2' failed."
The only documentation I can find for any Microsoft RegEx syntax is here which is not the runtime 5.5 VBScript library, but I'm not sure where else to get supported syntax.
Here is the code I'm using to test this. My database has a lot of linked tables.
Sub printServerStringInformation()
Dim rxPattern As String
rxPattern = "(?=SERVER)(.*)(?=;Trusted)"
Debug.Print RxMatch(CurrentDb.tableDefs(1).Connect, rxPattern, False)
rxPattern = "(?<=SERVER)(.*)(?=;Trusted)"
Debug.Print RxMatch(CurrentDb.tableDefs(1).Connect, rxPattern, False)
End Sub
Here is the function I am using:
Public Function RxMatch( _
ByVal SourceString As String, _
ByVal Pattern As String, _
Optional ByVal IgnoreCase As Boolean = True, _
Optional ByVal MultiLine As Boolean = True) As Variant
'Microsoft VBScript Regular Expressions 5.5
'http://www.zytrax.com/tech/web/regex.htm#more
'http://bytecomb.com/regular-expressions-in-vba/
'http://xkcd.com/1171/
On Error GoTo errHandler
Dim oMatches As MatchCollection
With New RegExp
.MultiLine = MultiLine
.IgnoreCase = IgnoreCase
.Global = False
.Pattern = Pattern
Set oMatches = .Execute(SourceString)
If oMatches.Count > 0 Then
RxMatch = oMatches(0).value
Else
RxMatch = ""
End If
End With
errHandler:
Debug.Print Err.Description
End Function
Here goes solution with RegEx (complete code which could be converted into function):
Sub qTest_3()
Dim objRE As New RegExp
Dim Tekst As String
Dim Wynik As Variant
Tekst = "ODBC;DRIVER=SQL Server;SERVER=compName\sqlexpress;Trusted_Connection=Yes;APP=Microsoft Office 2010;DATABASE=databaseName"
With objRE
.Global = True
.IgnoreCase = True
.Pattern = "(^.*;SERVER=)(.*)(;Trusted.*)"
Wynik = .Replace(Tekst, "$2") 'only 2nd part of the pattern will be returned
End With
Debug.Print Wynik
End Sub
Your function changed could be as follows (I added additional parameter setting part of the pattern which should be returned):
Public Function RxMatchReturn( _
ByVal SourceString As String, _
ByVal Pattern As String, _
StringPart As Byte, _
Optional ByVal IgnoreCase As Boolean = True, _
Optional ByVal MultiLine As Boolean = True) As Variant
'Microsoft VBScript Regular Expressions 5.5
On Error GoTo errHandler
Dim oMatches As MatchCollection
With New RegExp
.MultiLine = MultiLine
.IgnoreCase = IgnoreCase
.Global = True
.Pattern = Pattern
RxMatchReturn = .Replace(SourceString, "$" & StringPart)
End With
errHandler:
Debug.Print err.Description
End Function
I'm working with the following RegEx function in Excel 2010 and am getting the "Invalid Procedure Call or Argument" error on the last line of the function. I substituted the ActiveCell.Value for the constant (commented out). The constant did work properly, although the cell value does not.
What is causing this error to occur?
I appreciate any help in this. Thanks.
Sub SUB1()
Dim c As Variant
For Each c In Worksheets("Sheet1").Range("A1:D10").Cells
'MsgBox (c)
If RE6(c.Value) Then
c.Interior.ColorIndex = 7
Else
c.Interior.ColorIndex = 6
End If
Next
End Sub
Sub Test()
'Const strTest As String = "qwerty123456uiops"
Dim strTest As String
strTest = ActiveCell.Value
MsgBox RE6(strTest)
End Sub
Function RE6(strData As String) As String
Dim RE As Object
Dim REMatches As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.MultiLine = False
.Global = False
.IgnoreCase = True
.Pattern = "[0-9][0-9][0-9][0-9][0-9][0-9]"
End With
Set REMatches = RE.Execute(strData)
MsgBox ("REMatches.Count" & REMatches.Count)
'If Not REMatches Is Nothing Then
If REMatches.Count <= 0 Then
RE6 = ""
Else
RE6 = REMatches(0)
End If
'Else
'End If
End Function
Most likely there is no match: if you test the .Count property of REMatches is it zero?
Your function should test for that and return a suitable value (empty string maybe) instead.
EDIT: if you only want to check for the presence or absence of a pattern, then using .Test() is easier than using .Execute(). I changed your function to return a Boolean, which is more natural in this type of case.
Sub CheckCellValues()
Dim c As Range
For Each c In Worksheets("Sheet1").Range("A1:D10").Cells
If RE6(c.Value) Then
c.Interior.ColorIndex = 7
Else
c.Interior.ColorIndex = 6
End If
Next
End Sub
Function RE6(strData As String) As Boolean
Dim RE As Object
Dim REMatches As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.MultiLine = False
.Global = False
.IgnoreCase = True
.Pattern = "[0-9][0-9][0-9][0-9][0-9][0-9]"
End With
RE6 = RE.Test(strData) 'much simpler...
'or...
'REMatches = RE.Execute(strData)
'RE6 = (REMatches.Count > 0)
End Function
Your code appears to be aimed at testing whether a consecutive 6 digit number occurs in each cell in Sheet1 A1:D10, ie you are looking for a Boolean True/False so
Use a simpler pattern Re.Pattern = "[0-9]{6}"
Use the Regexp Test method - you don't need a collection of matches, just to know if one (as Re.Global = False) exists
Return a Boolean result from your function
Function RE6(strData As String) As Boolean
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.MultiLine = False
.Global = False
.IgnoreCase = True
.Pattern = "[0-9]{6}"
RE6 = .Test(strData)
End With
End Function
How do I grab the position of the first matched result in a regular expression? See below.
Function MYMATCH(strValue As String, strPattern As String, Optional blnCase As Boolean = True, Optional blnBoolean = True) As String
Dim objRegEx As Object
Dim strPosition As Integer
' Create regular expression.
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Pattern = strPattern
objRegEx.IgnoreCase = blnCase
' Do the search match.
strPosition = objRegEx.Match(strValue)
MYMATCH = strPosition
End Function
For one, I'm not entirely certain what .Match is returning (string, integer, etc.). The one solution I found said I should create a Match object to and then grab the position from there, but unlike vb, vba does not recognize the Match object. I've also seen some code like the following, but I'm not necessarily looking for the value, just the first string placement:
If allMatches.count <> 0 Then
result = allMatches.Item(0).submatches.Item(0)
End If
Somewhat ignoring any of the possible syntax errors above (mostly due to me changing variable types right and left), how do I easily/simply accomplish this?
Thanks!
You can use FirstIndex to return the position of matches using the Execute method, ie
Function MYMATCH(strValue As String, strPattern As String, Optional blnCase As Boolean = True, Optional blnBoolean = True) As String
Dim objRegEx As Object
Dim strPosition As Integer
Dim RegMC
' Create regular expression.
Set objRegEx = CreateObject("VBScript.RegExp")
With objRegEx
.Pattern = strPattern
.IgnoreCase = blnCase
If .test(strValue) Then
Set RegMC = .Execute(strValue)
MYMATCH = RegMC(0).firstindex + 1
Else
MYMATCH = "no match"
End If
End With
End Function
Sub TestMe()
MsgBox MYMATCH("test 1", "\d+")
End Sub
For the benefit of others who may be having this problem, I finally figured it out.
Option Explicit
Function CHAMATCH(strValue As String, strPattern As String, Optional blnCase As Boolean = True, Optional blnBoolean = True) As String
Dim objRegEx As Object
Dim objPosition As Object
Dim strPosition As String
' Create regular expression.
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Pattern = strPattern
objRegEx.IgnoreCase = blnCase
' Do the search match.
Set objPosition = objRegEx.Execute(strValue)
strPosition = objPosition(0).FirstIndex
CHAMATCH = strPosition
End Function
Instead of a Match type, just a regular Object type will do (considering all it's returning is a class). Then, if you want to grab the index location, just use .FirstIndex on the match [of your choice], or if you want the value, us .Value