'arnelgp
'find date inside a string
'
'returns string of dates if found
Public Function DatesInText(strText As String) As String
'Dim arrPattern(1 To 36) As String
Dim arrPattern(1 To 9) As String
Dim oRE, oMatches, oMatch
Dim i As Integer
Dim strDates As String
Dim collDates As Collection
'month-day-year
arrPattern(1) = "([1-9]|0[1-9]|1[012])[- /.]([1-9]|0[1-9]|[12][0-9]|3[01])[- /.]((19|20)[0-9]{2}|[0-9]{2})"
arrPattern(2) = "(jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec)[- /.]([1-9]|0[1-9]|[12][0-9]|3[01])[- /.]((19|20)[0-9]{2}|[0-9]{2})"
arrPattern(3) = "(january|february|march|april|july|august|september|october|november|december)[- /.]([1-9]|0[1-9]|[12][0-9]|3[01])[- /.]((19|20)[0-9]{2}|[0-9]{2})"
'day-month-year
arrPattern(4) = "([1-9]|0[1-9]|[12][0-9]|3[01])[- /.]([1-9]|0[1-9]|1[012])[- /.]((19|20)[0-9]{2}|[0-9]{2})"
arrPattern(5) = "([1-9]|0[1-9]|[12][0-9]|3[01])[- /.](jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec)[- /.]((19|20)[0-9]{2}|[0-9]{2})"
arrPattern(6) = "([1-9]|0[1-9]|[12][0-9]|3[01])[- /.](january|february|march|april|july|august|september|october|november|december)[- /.](((19|20)[0-9]{2})|[0-9]{2})"
'year-month-day
arrPattern(7) = "((19|20)[0-9]{2}|[0-9]{2})[- /.]([1-9]|0[1-9]|1[012])[- /.]([1-9]|0[1-9]|[12][0-9]|3[01])"
arrPattern(8) = "((19|20)[0-9]{2}|[0-9]{2})[- /.](jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec)[- /.]([1-9]|0[1-9]|[12][0-9]|3[01])"
arrPattern(9) = "((19|20)[0-9]{2}|[0-9]{2})[- /.](january|february|march|april|july|august|september|october|november|december)[- /.]([1-9]|0[1-9]|[12][0-9]|3[01])"
Set oRE = CreateObject("VBScript.RegExp")
Set collDates = New Collection
With oRE
.Global = True
.IgnoreCase = True
On Error Resume Next
For i = 1 To 9
.Pattern = arrPattern(i)
Set oMatches = .Execute(strText)
For Each oMatch In oMatches
collDates.Add oMatch.value, oMatch.value
'Debug.Print oMatch.value
Next
Next
End With
'remove dates not in origial text
For i = collDates.Count To 1 Step -1
With oRE
.Pattern = "(^|[ \x0A\,\.])" & collDates(i) & "($|[ \x0A\,\.])"
Set oMatches = .Execute(strText)
If oMatches.Count = 0 Then _
collDates.Remove collDates(i)
End With
Next
For i = 1 To collDates.Count
strDates = strDates & collDates(i) & ","
Next
Set collDates = Nothing
Set oMatches = Nothing
Set oRE = Nothing
If strDates <> "" Then strDates = Left(strDates, Len(strDates) - 1)
DatesInText = strDates
End Function