Negger said:
Can anyone show me how to enter an Input Mask for UK Postcodes, that covers
all 6, 7 & 8 character UK postcodes, e.g BS3 4LH (6), BS12 6GF (7), BS1 12CF
(7) & BS22 14JL (8). I can get an input mask to work for any one individual
format, but not one to cover all four! Someone please help!!!!!!
Mike Bunyan provided this code in a newsgoup post about 8 years ago. Try
this function to validate beforeupdate. Beware of text wrap. I have not
tested it personally (I don't live in the UK)
Attribute VB_Name = "UKPostCode"
Option Compare Database 'Use database order for string comparisons
Function IsValidUKPostcode(ByVal sPostcode As String) As Integer
' Function: IsValidUKPostcode
'
' Purpose: Check that a postcode conforms to the Royal Mail formats for UK
postcodes
'
' Params: sPostcode- Postcode string
'
' Returns: True (-1) - Postcode conforms to valid pattern
' False (0) - Postcode has failed pattern matching
'
' Usage: If Not Valid_UKPostcode(Me!PostCode) Then
' MsgBox "Invalid postcode",vbInformation
' End If
'----------------------------AfterUpdate--------
'calls module IsValidUKPostcode after update
'Private Sub PostCode_AfterUpdate()
'If Not IsNull([PostCode]) Then
' If Not IsValidUKPostcode([PostCode]) Then MsgBox "Invalid PostCode
format", vbInformation
'End If
'End Sub
'Option Compare Database
'Option Explicit
'----------------------------AfterUpdate--------
' Notes: This routine disregards leading and trailing spaces
' but there must only be one space between outcodes and incodes
' Capitalisation is not tested. Try using an input mask like >CCCCCCCC;
'
' Valid UK postcode formats
' Outcode Incode Example
' AN NAA B1 6AD
' ANN NAA S31 2BD
' AAN NAA SW5 8SG
' ANA NAA W1A 4DJ
' AANN NAA CB10 2BQ
' AANA NAA EC2A 1HQ
'
' Incode letters AA cannot be one of C,I,K,M,O or V.
' Based on discussion by John Douglas in Personal Computer World Articles
June 1998
' Michael Bunyan (
[email protected])
'
Dim sOutCode As String
Dim sInCode As String
Dim bValid As Integer
Dim iSpace As Integer
' Trim leading and trailing spaces
sPostcode = Trim(sPostcode)
iSpace = InStr(sPostcode, " ")
' If there is no space in the string then it is not a full postcode
If iSpace = 0 Then
IsValidUKPostcode = False
Exit Sub
End If
' Split post code into outcode and incodes
sOutCode = Left$(sPostcode, iSpace - 1)
sInCode = Mid$(sPostcode, iSpace + 1)
' Check incode is valid
' ... this will also test that the length is a valid 3 characters long
bValid = MatchPattern(sInCode, "NAA")
If bValid Then
' Test second and third characters for invalid letters
If InStr("CIKMOV", Mid$(sInCode, 2, 1)) > 0 Or InStr("CIKMOV",
Mid$(sInCode, 3, 1)) > 0 Then
bValid = False
End If
End If
If bValid Then
Select Case Len(sOutCode)
Case 0, 1
bValid = False
Case 2
bValid = MatchPattern(sOutCode, "AN")
Case 3
bValid = MatchPattern(sOutCode, "ANN") Or MatchPattern(sOutCode,
"AAN") Or MatchPattern(sOutCode, "ANA")
Case 4
bValid = MatchPattern(sOutCode, "AANN") Or
MatchPattern(sOutCode, "AANA")
End Select
End If
' If bValid is False by the time it gets here
' ...it has failed one of the above tests
IsValidUKPostcode = bValid
End Sub
Function MatchPattern(ByVal sString As String, ByVal sPattern As String) As
Integer
Dim cPattern As String
Dim cString As String
Dim iPosition As Integer
Dim bMatch As Integer
' If the lengths don't match then it fails the test
If Len(sString) <> Len(sPattern) Then
MatchPattern = False
Exit Function
End If
' All strings to uppercase - ByVal ensures callers string is not affected
sString = UCase(sString)
sPattern = UCase(sPattern)
' Assume it matches until proven otherwise
bMatch = True
For iPosition = 1 To Len(sString)
' Take the characters at the current position from both strings
cPattern = Mid$(sPattern, iPosition, 1)
cString = Mid$(sString, iPosition, 1)
' See if the source character conforms to the pattern one
Select Case cPattern
Case "N" ' Numeric
If Not IsNumeric(cString) Then bMatch = False
Case "A" ' Alphabetic
If Not (cString >= "A" And cString <= "Z") Then bMatch = False
End Select
Next iPosition
MatchPattern = bMatch
End Function
--
Arvin Meyer, MCP, MVP
Microsoft Access
Free Access downloads:
http://www.datastrat.com
http://www.mvps.org/access