Option Explicit
'John Nurick, http://www.mvps.org/access/modules/mdl0063.htm
'Some useful regular expressions:
'Notes:
'Each of these regular expressions is wrapped in a (?: )
'grouping pattern. This means that they can be OR'd by
'concatenating them with the pipe character "|". Thus
' rgxZIP_US & "|" & rgxZIP_CA
'will match either US or Canadian postal codes.
'
'Official formatting of postcodes and the like may change
'over time. Some of these expressions may need adjustment
' to bring them up to date.
'UK Postcode
Public Const rgxZIP_UK = "(?:(?:A[BL]|B[ABDHLNRST]?|" _
& "C[ABFHMORTVW]|D[ADEGHLNTY]|E[CHNX]?|F[KY]|G[LUY]?|" _
& "H[ADGPRSUX]|I[GMPV]|JE|K[ATWY]|L[ADELNSU]?|M[EKL]?|" _
& "N[EGNPRW]?|O[LX]|P[AEHLOR]|R[GHM]|S[AEGKLMNOPRSTWY]?|" _
& "T[ADFNQRSW]|UB|W[ACDFNRSV]?|YO|ZE)" _
& "\d(?:\d|[A-Z])? \d[A-Z]{2})"
'A simpler expression that does not check for valid postcode areas:
' "(?:[A-Z]{1,2}\d(?:\d|[A-Z])? \d[A-Z]{2})"
'Zip or Zip+4
Public Const rgxZIP_US = "(?:\d{5}(?:-\d{4})?)"
'Canadian postal codes
Public Const rgxZip_CA = "(?:[A-Z]\d[A-Z] \d[A-Z]\d)"
'Most European postal codes:
Public Const rgxZIP_EU = "(?:NL-\d{4}(?: [A-Z][A-Z])|" _
& "(?:IS|FO)\d{3}|" _
& "(?:A|B|CH|CY|DK|EE|H|L|LT|LV|N)-\d{4}|" _
& "(?:BA|DE?|E|FR?|FIN?|HR|I|SI|YU)-\d{5}|" _
& "(?:CZ|GR|S|SK)-\d{3} \d{2}|PL-\d\d-\d{3}|" _
& "PT-\d{4}(?:-\d{3})?" _
& ")"
'A simpler expression that doesn't check the postcode
'format against the country code
' "(?:NL[- ]\d{4} [A-Z][A-Z]|" _
' & "(?:[A-Z]{1,2}[- ])?\d{2,3}(?:\d\d?| \d\d|\d-\d{3}))"
'US States
Public Const rgxSTATES_US = "(:?A[KLRZ]|C[AOT]|D[CE]|FL|" _
& "GA|HI|I[ADLN]|K[SY]|LA|M[ADEINOST]|N[CDEHJMVY]|" _
& "O[HKR]|P[AR]|RI|S[CD]|T[NX]|" _
& "UT|V[AIT]|W[AIVY])"
'Australian States
Public Const rgxSTATES_AU = "(?:ACT|NSW|NT|QLD|SA|TAS|VIC|WA)"
'Canadian Provinces
Public Const rgxPROVINCES_CA = "(?:AB|BC|MB|N[BLTSU]|ON|PE|QC|SK|YT)"
'Canonical phone number
Public Const rgxPHONE_INTL = "(?:\+\d{1,4} ?(?:\(\d{0,5}\))?(?:\d+[-. ])*\d{2,})"
Function rgxValidate( _
target As Variant, _
Pattern As String, _
Optional CaseSensitive As Boolean = False, _
Optional MatchWholeString As Boolean = True, _
Optional FailOnError As Boolean = True) _
As Boolean
'Returns True if Target matches the regular
'expression Pattern.
'By John Nurick, October 2002 - January 2003
'©2003 John Nurick
'NOTES:
'Target will normally be a String. If Target is Null,
'rgxValidate returns False. Otherwise if Target cannot be
'converted to a string with CStr(), rgxValidate fails
'with Error 13, Type Mismatch.
'Pattern should be a VBScript regular expression. See VBScript
'help file and other documentation for information.
'CaseSensitive does the expected.
'MatchWholeString: if False, rgxValidate returns True if any
'substring of Target matches Pattern. If True or omitted,
'the function only returns True if the whole of Target
'matches Pattern.
' E.g. Target "12345" only matches Pattern "234" if
' MatchWholeString is False.
'FailOnError: if this is True or omitted, rgxValidate passes
'any run time error to the calling procedure. If it is False,
'the function returns True on a successful match and False if
'the match fails for any reason including a run time error.
'rgxValidate is suitable for use in data entry forms and the
'like. It can also be used in queries and in looping through
'recordsets, but because it creates a RegExp object and compiles
'the regular expression (Pattern) every time it is called,
'it is rather inefficient for repetitive operations.
'Constants for messages:
Const rgxPROC_NAME = "rgxValidate"
Const rgxERRMSG_CREATE = "Could not create VBScript.RegExp object: "
Const rgxERRMSG_UNEXPECTED = "Unexpected error: "
'VBScript.Regexp error messages:
Const rgxERRMSG_5017 = "Syntax error in regular expression"
Const rgxERRMSG_5019 = "Expected ']' in regular expression"
Const rgxERRMSG_5020 = "Expected ')' in regular expression"
Dim oRE As Object
On Error GoTo ERRHANDLER
rgxValidate = False 'Set default return value
If IsNull(target) Then Exit Function
Set oRE = CreateObject("VBScript.RegExp")
'If we're here, the object has been created
oRE.Global = False
oRE.IgnoreCase = Not CaseSensitive
oRE.MultiLine = False
If MatchWholeString Then
'Add anchors at ends of Pattern
'(doesn't matter if Pattern already has them)
oRE.Pattern = "^" & Pattern & "$"
Else
oRE.Pattern = Pattern
End If
'Do it!
rgxValidate = oRE.test(CStr(target))
'If we're here, the match executed OK. Normal termination
Set oRE = Nothing
Exit Function
ERRHANDLER:
If FailOnError Then
With Err
Select Case .Number
Case 5017: .Description = rgxERRMSG_5017
Case 5019: .Description = rgxERRMSG_5019
Case 5020: .Description = rgxERRMSG_5020
Case Else
If oRE Is Nothing Then
.Description = rgxERRMSG_CREATE & Err.Description
Else
.Description = rgxERRMSG_UNEXPECTED & Err.Description
End If
End Select
Set oRE = Nothing
Err.Raise Err.Number, , rgxPROC_NAME & "(): " & .Description
End With
Else 'Fail silently
Err.Clear
Set oRE = Nothing
End If
End Function
