Binaryworld - Using Regular Expression With VB6 (Using Search/Replace , Match Collec ... [ VB -> Regular Expression ]

This article will show you how you can use Regular Expression to do some complex Search and Replace task with Regular Expression. This demo will show you use of Matches and SubMatches collection to get all Matches in input string and SubMatches in a single Match.

Click here to copy the following block

'/////////////////////////////////////////////////
'//RegX Demo
'/////////////////////////////////////////////////

Private Sub Form_Load()
  '// Search and Replace Demo. This demo will make keyword link for Google
  MsgBox (SearchReplaceRegX("This is RegX demo. <span>VB Stuff is kool VC also kool and ASP dam Kool</span>. Try it" _
      , "\b(VB|VC|ASP)\b" _
      , "<A HREF='http://www.google.com/q=$1'>$1</A>"))

  '//Match Collection Demo
  MsgBox (RegExpTest("is.", "IS1 is2 IS3 is4"))

  '//Sub Match Collection Demo
  MsgBox (SubMatchTest("Please send mail to dragon@xyzzy.com. Thanks!"))
End Sub

Function SearchReplaceRegX(inputStr, SearchPattern, ReplacePattern) As String
  Dim str, objRegExp
  str = inputStr
  Set objRegExp = CreateObject("VBScript.RegExp")

  '//Change All Occurances ?
  objRegExp.Global = True

  '//this pattern makes sure it does not modify phrases that are already in <A> tags
  objRegExp.Pattern = SearchPattern

  '//Use following code to get all matches
  'Set objMatches = objRegExp.Execute(str)
  'For Each match In objMatches
  '  Debug.Print match
  'Next

  '//You can use following to test your RegEx --It will return True if Match
  'Debug.Print objRegExp.Test(str)

  str = objRegExp.Replace(str, ReplacePattern)
  SearchReplaceRegX = str

End Function

'//Example to find all Sub matches in a match
Function SubMatchTest(inpStr)
  Dim oRe, oMatch, oMatches
  'Set oRe = New RegExp
  Set oRe = CreateObject("VBScript.RegExp")

  ' Look for an e-mail address (not a perfect RegExp)
  oRe.Pattern = "(\w+)@(\w+)\.(\w+)"
  ' Get the Matches collection
  Set oMatches = oRe.Execute(inpStr)

  ' Get the first item in the Matches collection
  Set oMatch = oMatches(0)
  ' Create the results string.
  ' The Match object is the entire match - dragon@xyzzy.com
  retStr = "Email address is: " & oMatch & vbNewLine
  ' Get the sub-matched parts of the address.
  retStr = retStr & "Email alias is: " & oMatch.SubMatches(0)  ' dragon
  retStr = retStr & vbNewLine
  retStr = retStr & "Organization is: " & oMatch.SubMatches(1)  ' xyzzy
  SubMatchTest = retStr
End Function

Function RegExpTest(patrn, strng)
  Dim regEx, Match, Matches, I              ' Create variable.
  'Set regEx = New RegExp ' Create regular expression.
  Set regEx = CreateObject("VBScript.RegExp")

  regEx.Pattern = patrn                 ' Set pattern.
  regEx.IgnoreCase = True                ' Set case insensitivity.
  regEx.Global = True                  ' Set global applicability.

  Set Matches = regEx.Execute(strng)           ' Execute search.
  For Each Match In Matches               ' Iterate Matches collection.
    I = I + 1
    retStr = retStr & "Match " & I & " found at position "
    retStr = retStr & Match.FirstIndex & ". Match Value is "  '
    retStr = retStr & Match.Value & "'." & vbCrLf
  Next
  RegExpTest = retStr
End Function