extracting data from strings

Public Function Matches(Subject As String) As String()


Dim RE As Object
Dim MatchList As Object
Dim Match As Variant
Dim i As Long
Dim MatchArray(1 To 4) As String


Const Pattern = ".*Name\s*(.*)\s*Telephone\s*No.\s*(.*)\s*Email\s*(.*)\s*Company\s*Name\s*(.*)\s*Company\s*Registration.*"


Set RE = GetRE(Pattern:=Pattern, IgnoreCase:=False, GlobalMatch:=False)


Set MatchList = RE.Execute(Subject)


For i = 1 To 4


For Each Match In MatchList
MatchArray(i) = RE.Replace(Match, "$" & i)
Next Match


Next i


Set RE = Nothing
Matches = MatchArray


End Function


' Return a RexExp object
Public Function GetRE(Optional Pattern As String = "", _
Optional IgnoreCase As Boolean = False, _
Optional GlobalMatch As Boolean = True) As Object


Set GetRE = CreateObject("vbscript.regexp")


GetRE.Pattern = Pattern
GetRE.IgnoreCase = IgnoreCase
GetRE.Global = GlobalMatch


End Function