Cleans fields containing surname and forenames
'***************************************************************************
'*** Name : CleanInvalidNameChars
'*** Purpose: Clean up the input to chars that are not alpha, "'", ".", "-",
'*** or " ". Also removes consecutive spaces.
'*** Inputs : dirtyString
'*** Outputs:
'***
'*** Return : String
'***************************************************************************
Private Function CleanInvalidNameChars(ByVal dirtyString As String) As String
Const ALPHAS = "[ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz]"
Const PUNCS = "['.-]"
Dim i As Long
Dim strPartClean As String
Dim strClean As String
Dim ch As String
Dim bFoundFirstAlpha As Boolean
Dim arrNonConsecChars As Variant
For i = 1 To Len(dirtyString)
ch = Mid(dirtyString, i, 1)
If ch Like ALPHAS Then
strPartClean = strPartClean & ch
bFoundFirstAlpha = True
ElseIf bFoundFirstAlpha And (ch Like PUNCS Or ch = " ") Then
strPartClean = strPartClean & ch
End If
Next
bFoundFirstAlpha = False
For i = Len(strPartClean) To 1 Step -1
ch = Mid(strPartClean, i, 1)
If ch Like ALPHAS Then
strClean = ch & strClean
bFoundFirstAlpha = True
ElseIf bFoundFirstAlpha And (ch Like PUNCS Or ch = " ") Then
strClean = ch & strClean
End If
Next
arrNonConsecChars = Array(" ")
For i = LBound(arrNonConsecChars) To UBound(arrNonConsecChars)
ch = arrNonConsecChars(i)
Do
strClean = Replace(strClean, ch & ch, ch)
Loop While InStr(1, strClean, ch & ch) > 0
Next
CleanInvalidNameChars = strClean
End Function