This is my regex:
Dim vbRegX As Object, vbRegXMatch As Object
Set vbRegX = CreateObject("vbscript.regexp")
With vbRegX
.Global = True
.IgnoreCase = True
.Pattern = "^[a-zA-Z0-9_-]{1,20}$"
End With
code that uses it:
Set vbRegXMatch = vbRegX.Execute(Me.txtProduct.Text)
If vbRegXMatch.Count = 1 Then
MsgBox "This string has invalid characters in it. Illegal characters are out side of the following ranges:" & vbNewLine & vbNewling & "a-z or A-Z" & vbNewLine & vbNewling & "0-9, - or _. Please try again."
Cancel = True
Me.txtProduct.SetFocus
Set vbRegXMatch = Nothing
Set vbRegX = Nothing
Exit Sub
End If
This code fires with invalid characters but not when length is > 20. This is the output given to me by Regex Buddy:
Dim FoundMatch As Boolean
Dim myRegExp As RegExp
Set myRegExp = New RegExp
myRegExp.Pattern = "^[a-zA-Z0-9_-]{1,20}$"
FoundMatch = myRegExp.Test(SubjectString)
Can anyone so kindly point out what Im missing?
visual of the control:
Your regex matches valid input. Thus, you need to .Test(your_string) and if the result is False, you need to fire an error.
Replace
Set vbRegXMatch = vbRegX.Execute(Me.txtProduct.Text)
If vbRegXMatch.Count = 1 Then
with
If vbRegX.Test("1234555") = False Then
Also, since you expect a single match, use
.Global = False
Related
My VBA function should take a string referencing a range of units (i.e. "WWW1-5") and then return another string.
I want to take the argument, and put it in a comma separated string,
So "WWW1-5" should become "WWW1, WWW2, WWW3, WWW4, WWW5".
It's not always going to be a single digit. For example, I might need to separate "XXX11-18" or something similar.
I have never used regular expressions, but keep trying different things to make this work and it seems to only be finding 1 match instead of 3.
Any ideas? Here is my code:
Private Function split_group(ByVal group As String) As String
Dim re As Object
Dim matches As Object
Dim result As String
Dim prefix As String
Dim startVar As Integer
Dim endVar As Integer
Dim i As Integer
Set re = CreateObject("vbscript.regexp")
re.Pattern = "([A-Z]+)(\d+)[-](\d+)"
re.IgnoreCase = False
Set matches = re.Execute(group)
Debug.Print matches.Count
If matches.Count <> 0 Then
prefix = matches.Item(0)
startVar = CInt(matches.Item(1)) 'error occurs here
endVar = CInt(matches.Item(2))
result = ""
For i = startVar To endVar - 1
result = result & prefix & i & ","
Next i
split_group = result & prefix & endVar
Else
MsgBox "There is an error with splitting a group."
split_group = "ERROR"
End If
End Function
I tried setting global = true but I realized that wasn't the problem. The error actually occurs on the line with the comment but I assume it's because there was only 1 match.
I tried googling it but everyone's situation seemed to be a little different than mine and since this is my first time using RE I don't think I understand the patterns enough to see if maybe that was the problem.
Thanks!
Try the modified Function below:
Private Function split_metergroup(ByVal group As String) As String
Dim re As Object
Dim matches As Variant
Dim result As String
Dim prefix As String
Dim startVar As Integer
Dim endVar As Integer
Dim i As Integer
Set re = CreateObject("VBScript.RegExp")
With re
.Global = True
.IgnoreCase = True
.Pattern = "[0-9]{1,20}" '<-- Modified the Pattern
End With
Set matches = re.Execute(group)
If matches.Count > 0 Then
startVar = CInt(matches.Item(0)) ' <-- modified
endVar = CInt(matches.Item(1)) ' <-- modified
prefix = Left(group, InStr(group, startVar) - 1) ' <-- modified
result = ""
For i = startVar To endVar - 1
result = result & prefix & i & ","
Next i
split_metergroup = result & prefix & endVar
Else
MsgBox "There is an error with splitting a meter group."
split_metergroup = "ERROR"
End If
End Function
The Sub I've tested it with:
Option Explicit
Sub TestRegEx()
Dim Res As String
Res = split_metergroup("DEV11-18")
Debug.Print Res
End Sub
Result I got in the immediate window:
DEV11,DEV12,DEV13,DEV14,DEV15,DEV16,DEV17,DEV18
Another RegExp option, this one uses SubMatches:
Test
Sub TestRegEx()
Dim StrTst As String
MsgBox WallIndside("WAL7-21")
End Sub
Code
Function WallIndside(StrIn As String) As String
Dim objRegex As Object
Dim objRegMC As Object
Dim lngCnt As Long
Set objRegex = CreateObject("VBScript.RegExp")
With objRegex
.Global = True
.IgnoreCase = True
.Pattern = "([a-z]+)(\d+)-(\d+)"
If .test(StrIn) Then
Set objRegMC = .Execute(StrIn)
For lngCnt = objRegMC(0).submatches(1) To objRegMC(0).submatches(2)
WallIndside = WallIndside & (objRegMC(0).submatches(0) & lngCnt & ", ")
Next
WallIndside = Left$(WallIndside, Len(WallIndside) - 2)
Else
WallIndside = "no match"
End If
End With
End Function
#Shai Rado 's answer worked. But I figured out on my own WHY my original code was not working, and was able to lightly modify it.
The pattern was finding only 1 match because it was finding 1 FULL MATCH. The full match was the entire string. The submatches were really what I was trying to get.
And this is what I modified to make the original code work (asking for each submatch of the 1 full match):
So what I am looking to find out, because I'm new to regular expressions, is if it's possible to replace my "Invalid" return statement with a similar statement commented out on the next line, where the character and/or character # of the expression failed at.
Let's use "msteede48#hotmail#.com" as an example input for myEmail variable below...
Option Explicit
Function ValidEmail(myEmail As String) As String
Dim regExp As Object
Set regExp = CreateObject("VBScript.Regexp")
If Len(myEmail) < 6 Then
ValidEmail = ""
Else
With regExp
.Global = True
.IgnoreCase = True
.Pattern = "^(?=[a-z0-9#.!#$%&'*+/=?^_`{|}~-]{6,254}$)(?=[a-z0-9.!#$%&'*+/=?^_`{|}~-]{1,64}#)[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*#(?:(?=[a-z0-9-]{1,63}\.)[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+(?=[a-z0-9-]{1,63}$)[a-z0-9](?:[a-z0-9-]*[a-z0-9])?$"
End With
If regExp.Test(myEmail) = True Then
ValidEmail = "Valid"
Else
ValidEmail = "Invalid"
'ValidEmail = "Error at character:" & CodeToDetermineWhatChar#TheRegexpFailedAtGoesHere & " with a(n):" & CodeToDetermineWhatCharTheRegexpFailedAtGoesHere & "."
End If
End If
Set regExp = Nothing
End Function
Where the output would be something like: Error at character:18 with a(n):#.
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}"
I'm trying to match experience levels for various positions based on 1. Degree 2. Years of Experience. The pattern is fairly simple (example: "BS/5" would be a bachelors of science with 5 years of experience. I also have entries that follow this scheme but have multiple degrees and experience levels in the same string (example: "BS/5-MS/2") that are considered equivalent. I've got a basic function that will match and find the substring pattern but it never returns more than one match even though I've set the .Global property to true for the regexp object. Any ideas? Code below:
On Error Resume Next
ActiveWorkbook.VBProject.References.AddFromGuid "{3F4DACA7-160D-11D2-A8E9-00104B365C9F}", 5, 5
Dim theRegex As Object
Dim theString As String
Set theRegex = CreateObject("VBScript.RegExp")
With regex
.MultiLine = False
.Global = True
.IgnoreCase = False
End With
theRegex.Pattern = "([A-z][A-z][A-z]?/[0-9][0-9]?)"
theString = "MS/9-PhD/4"
Set MyMatches = theRegex.Execute(theString)
Debug.Print "SubMatches.Count: " & MyMatches.Item(0).SubMatches.Count
If MyMatches.Count <> 0 Then
With MyMatches
For myMatchCt = 0 To .Count - 1
Debug.Print "myMatchCt: " & myMatchCt
For subMtCt = 0 To .Item(subMtCt).SubMatches.Count - 1
Debug.Print "subMtCt: " & subMtCt
Debug.Print ("," & .Item(myMatchCt).SubMatches.Item(subMtCt))
Next
Next
End With
Else
Debug.Print "No Matches"
End If
Try changing the line With Regex
to
With theRegex
.MultiLine = False
.Global = True
.IgnoreCase = False
End With
Your On Error resume next statement is disguising the error.
Starting out at a new job and I have to go through a whole lot of documents that my predecessor left. They are MS Word-files that contain information on several hundreds of patents. Instead of copy/pasting every single patent-number in an online form, I would like to replace all patent-numbers with a clickable hyperlink. I guess this should be done with vbscript (I'm not used to working with MS Office).
I have so far:
<obsolete>
This is not working for me:
1. I (probably) need to add something to loop through the ActiveDocument
2. The replace-function probably needs a string and not an object for a parameter - is there a __toString() in vbscript?
THX!
UPDATE:
I have this partially working (regex and finding matches) - now if only I could get the anchor for the hyperlink.add-method right...
Sub HyperlinkPatentNumbers()
'
' HyperlinkPatentNumbers Macro
'
Dim objRegExp, Matches, match, myRange
Set myRange = ActiveDocument.Content
Set objRegExp = CreateObject("VBScript.RegExp")
With objRegExp
.Global = True
.IgnoreCase = False
.Pattern = "(WO|EP|US)([0-9]*)(A1|A2|B1|B2)"
End With
Set Matches = objRegExp.Execute(myRange)
If Matches.Count >= 1 Then
For Each match In Matches
ActiveDocument.Hyperlinks.Add Anchor:=objRegExp.match, Address:="http://worldwide.espacenet.com/publicationDetails/biblio?DB=EPODOC&adjacent=true&locale=en_EP&CC=$1&NR=$2&KC=$3"
Next
End If
Set Matches = Nothing
Set objRegExp = Nothing
End Sub
Is this VBA or VBScript? In VBScript you cannot declare types like Dim newText As hyperLink, but every variable is a variant, so: Dim newText and nothing more.
objRegEx.Replace returns the string with replacements and needs two parameters passed into it: The original string and the text you want to replace the pattern with:
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Global = True
objRegEx.IgnoreCase = False
objRegEx.Pattern = "^(WO|EP|US)([0-9]*)(A1|A2|B1|B2)$"
' assuming plainText contains the text you want to create the hyperlink for
strName = objRegEx.Replace(plainText, "$1$2$3")
strAddress = objRegex.Replace(plainText, "http://worldwide.espacenet.com/publicationDetails/biblio?DB=EPODOC&adjacent=true&locale=en_EP&CC=$1&NR=$2&KC=$3"
Now you can use strName and strAddress to create the hyperlink with.
Pro-tip: You can use objRegEx.Test(plainText) to see if the regexp matches anything for early handling of errors.
Problem solved:
Sub addHyperlinkToNumbers()
Dim objRegExp As Object
Dim matchRange As Range
Dim Matches
Dim match
Set objRegExp = CreateObject("VBScript.RegExp")
With objRegExp
.Global = True
.IgnoreCase = False
.Pattern = "(WO|EP|US|FR|DE|GB|NL)([0-9]+)(A1|A2|A3|A4|B1|B2|B3|B4)"
End With
Set Matches = objRegExp.Execute(ActiveDocument.Content)
For Each match In Matches
'This doesn't work, because of the WYSIWYG-model of MS Word:
'Set matchRange = ActiveDocument.Range(match.FirstIndex, match.FirstIndex + Len(match.Value))
Set matchRange = ActiveDocument.Content
With matchRange.Find
.Text = match.Value
.MatchWholeWord = True
.MatchCase = True
.Wrap = wdFindStop
.Execute
End With
ActiveDocument.Hyperlinks.Add Anchor:=matchRange, _
Address:="http://worldwide.espacenet.com/publicationDetails/biblio?DB=EPODOC&adjacent=true&locale=en_EP&CC=" _
& match.Submatches(0) & "&NR=" & match.Submatches(1) & "&KC=" & match.Submatches(2)
Next
MsgBox "Hyperlink added to " & Matches.Count & " patent numbers"
Set objRegExp = Nothing
Set matchRange = Nothing
Set Matches = Nothing
Set match = Nothing
End Sub