VBA Modules: Access: accPostCodes v1.03

Read this for full information on these modules


I wrote this module to help me out processing and extracting GB post codes, which can have a number of combinations:

A1 2BC
A12 3BC
AB1 2CD
AB12 3CD
AB1C 2DE

accPostCodeExtract is probably the most useful function here, as it will extract the post code from the end of a long address string.  There are options to work with most source string formats.  By default, the result will be padded with spaces to length = 8, e.g. "AB1  2CD"

accPostCodePrefix extracts the post code "town", e.g. "AB" from "AB1 2CD"
accPostCodePrefixWithNumber extracts the full post code prefix, e.g. "AB1" from "AB1 2CD"

'accPostCodes
'v1.03 2013-11-29 13:03

'===========================================================================
' HELP CONTACT
'===========================================================================
' Code is provided without warranty and can be stolen and amended as required.
'   Tom Parish
'   TJP@tomparish.me.uk
'   http://baldywrittencod.blogspot.com/2013/11/vba-modules-access-accpostcodes.html
'   DGF Help Contact: see BPMHelpContact module
'=========================================================================

'   v1.03   accPostCodeExtract: bugfix where original post code already padded to len=8
'   v1.02   accPostCodeExtract: added bPadResult option, bugfix where string is just post code
'   v1.01   added accPostCodeExtract
'   v1.00   original version

Option Explicit
Option Compare Database

Function accPostCode(ByRef PCode, Optional ByVal FWSrcSys) As String
'v1.00 2013-11-29 11:53

Dim sPCode As String, sFWsys As String
On Error Resume Next
sPCode = PCode
sFWsys = FWSrcSys
On Error GoTo 0

If sFWsys = "LO" Then Exit Function

'extract "GB/" from start of NFE PCode
Dim b As Byte
b = InStr(sPCode, "/")
sPCode = Mid(sPCode, b + 1, Len(sPCode))

If sPCode = "" Or sPCode = "0" Or sPCode = "." Or sPCode = "#" Then Exit Function

accPostCode = sPCode

End Function

Function accPostCodePrefix(ByRef PCode, Optional ByVal FWSrcSys) As String
'v1.00 2013-11-29 11:53
'checks first 1-2 characters for alpha prefix

Dim sPCode As String, sFWsys As String
On Error Resume Next
sPCode = PCode
sFWsys = FWSrcSys
On Error GoTo 0

If sFWsys = "LO" Then Exit Function

Dim s As String
sPCode = accPostCode(sPCode)
If sPCode = "" Then Exit Function
s = Left(sPCode, 1)
If IsNumeric(s) Then Exit Function Else accPostCodePrefix = s
s = Mid(sPCode, 2, 1)
If IsNumeric(s) Then Exit Function Else accPostCodePrefix = accPostCodePrefix & s

End Function

Function accPostCodePrefixWithNumber(ByVal PCode, Optional ByVal FWSrcSys) As String
'v1.00 2013-11-29 11:53
'checks first 2 characters for alpha prefix then checks following 2-3 chars for numeric

Dim sPCode As String, sFWsys As String
On Error Resume Next
sPCode = PCode
sFWsys = FWSrcSys
On Error GoTo 0

If sFWsys = "LO" Then Exit Function

Dim b As Byte, APfx As String, ANPfx As String
APfx = accPostCodePrefix(sPCode)
If APfx = "" Then Exit Function
b = InStr(sPCode, " ")
If b > 0 Then
'just use characters before space
    ANPfx = Left(sPCode, b - 1)
Else
'no space, deduce logically
'e.g. for AB123CD need AB12, take APfx plus all except last following numeric character
    ANPfx = APfx & Mid(sPCode, Len(APfx) + 1, 3)
    'e.g. AB123 or AB12C or AB1C2
    If ANPfx = sPCode Then
    'e.g. AB12[] so only prefix anyway
    ElseIf IsNumeric(Mid(ANPfx, Len(ANPfx), 1)) Then
    'e.g. AB123[CD] so AB12 3CD
        ANPfx = Left(ANPfx, Len(ANPfx) - 1)
    ElseIf IsNumeric(Mid(ANPfx, Len(ANPfx) - 1, 1)) Then
    'e.g. AB12C[D] so AB1 2CD
        ANPfx = Left(ANPfx, Len(ANPfx) - 2)
    ElseIf IsNumeric(Mid(ANPfx, 3, 1)) And Not IsNumeric(Mid(ANPfx, 4, 1)) Then
    'e.g. AB1C2[DE] so AB1C 2DE
        ANPfx = Left(ANPfx, Len(ANPfx) - 1)
    Else
    'cannot identify
        ANPfx = ""
    End If
End If

accPostCodePrefixWithNumber = ANPfx

End Function

Function accPostCodeExtract(ByVal FullAddressString, Optional ByVal bPostCodeNoSpace As Boolean = False _
    , Optional ByVal bCommaSeparated As Boolean = False, Optional bPadResult As Boolean = True) As String
'v1.03 2013-11-29 13:03
'extracts the post code from the end of a long address string (after the last-but-one space [or comma])
'e.g. "CITY, County, AB12 3CD" becomes "AB12 3CD"
'NB: with "AB123CD" post code formats, use bPostCodeNoSpace = True
'NB: with "City,County,AB12 3CD" format strings, use bCommaSeparated = True
'NB: to pad result to fixed 8 characters, use bPadResult = True

On Error Resume Next

Dim FullString As String
FullString = FullAddressString
If FullString = "" Then Exit Function

Dim sSearchString As String, sCount As Byte
If bCommaSeparated Then
    sSearchString = ","
    sCount = 1
Else
    sSearchString = " "
    If bPostCodeNoSpace Then sCount = 1 Else sCount = 2
    While InStr(FullString, "  ") > 0
        FullString = Replace(FullString, "  ", " ")
    Wend
End If

Dim findspaces() As Integer, f As Integer, fCount As Byte
fCount = 1
While InStr(f + 1, FullString, sSearchString) > 0
ReDim Preserve findspaces(1 To fCount) As Integer
f = InStr(f + 1, FullString, sSearchString)
findspaces(fCount) = f
fCount = fCount + 1
Wend
accPostCodeExtract = Mid(FullString, findspaces(fCount - sCount) + 1, Len(FullString))
If accPostCodeExtract = "" Then accPostCodeExtract = FullString
If bPostCodeNoSpace Then accPostCodeExtract = Left(accPostCodeExtract, Len(accPostCodeExtract) - 3) & " " & Right(accPostCodeExtract, 3)
If bPadResult Then
    While Len(accPostCodeExtract) < 8
        accPostCodeExtract = Left(accPostCodeExtract, Len(accPostCodeExtract) - 3) & " " & Right(accPostCodeExtract, 3)
    Wend
End If

End Function