Advertisement
Guest User

Untitled

a guest
Feb 9th, 2012
154
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.04 KB | None | 0 0
  1. Public Function RXGET(ByRef find_pattern As Variant, _
  2. ByRef within_text As Variant, _
  3. Optional ByVal submatch As Long = 0, _
  4. Optional ByVal start_num As Long = 0, _
  5. Optional ByVal case_sensitive As Boolean = True) As Variant
  6. ' RXGET - Looks for a match for regular expression pattern find_pattern
  7. ' in the string within_text and returns it if found, error otherwise.
  8. ' Optional long submatch may be used to return the corresponding submatch
  9. ' if specified - otherwise the entire match is returned.
  10. ' Optional long start_num specifies the number of the character to start
  11. ' searching for in within_text. Default=0.
  12. ' Optional boolean case_sensitive makes the regex pattern case sensitive
  13. ' if true, insensitive otherwise. Default=true.
  14.  
  15. Dim objRegex As VBScript_RegExp_55.RegExp
  16. Dim colMatch As VBScript_RegExp_55.MatchCollection
  17. Dim vbsMatch As VBScript_RegExp_55.Match
  18. Dim colSubMatch As VBScript_RegExp_55.SubMatches
  19. Dim sMatchString As String
  20.  
  21. Set objRegex = New VBScript_RegExp_55.RegExp
  22.  
  23. ' Initialise Regex object
  24. With objRegex
  25. .Global = False
  26. ' Default is case sensitive
  27. If case_sensitive Then
  28. .IgnoreCase = False
  29. Else: .IgnoreCase = True
  30. End If
  31. .pattern = find_pattern
  32. End With
  33.  
  34. ' Return out of bounds error
  35. If start_num >= Len(within_text) Then
  36. RXGET = CVErr(xlErrNum)
  37. Exit Function
  38. End If
  39. sMatchString = Right$(within_text, Len(within_text) - start_num)
  40.  
  41. ' Create Match collection
  42. Set colMatch = objRegex.Execute(sMatchString)
  43. If colMatch.Count = 0 Then ' No match
  44. RXGET = CVErr(xlErrNA)
  45. Else
  46. Set vbsMatch = colMatch(0)
  47. If submatch = 0 Then ' Return match value
  48. RXGET = vbsMatch.Value
  49. Else
  50. Set colSubMatch = vbsMatch.SubMatches ' Use the submatch collection
  51. If colSubMatch.Count < submatch Then
  52. RXGET = CVErr(xlErrNum)
  53. Else
  54. RXGET = CStr(colSubMatch(submatch - 1))
  55. End If
  56. End If
  57. End If
  58. End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement