Sunday, 24 June 2012

Ex12: VBA - Proper() function using DAO

Convert mixed case name into a name with spaces using DAO in VBA

Option Compare Database
Option Explicit

'Constants for examining how a field is indexed.
Private Const intcIndexNone As Integer = 0
Private Const intcIndexGeneral As Integer = 1
Private Const intcIndexUnique As Integer = 3
Private Const intcIndexPrimary As Integer = 7


Function ConvertMixedCase(ByVal strIn As String) As String
    'Purpose:   Convert mixed case name into a name with spaces.
    'Argument:  String to convert.
    'Return:    String converted by these rules:
    '           1. One space before an upper case letter.
    '           2. Replace underscores with spaces.
    '           3. No spaces between continuing upper case.
    'Example:   "FirstName" or "First_Name" => "First Name".
    Dim lngStart As Long        'Loop through string.
    Dim strOut As String        'Output string.
    Dim boolWasSpace As Boolean 'Last char. was a space.
    Dim boolWasUpper As Boolean 'Last char. was upper case.
    
    strIn = Trim$(strIn)        'Remove leading/trailing spaces.
    boolWasUpper = True         'Initialize for no first space.
    
    For lngStart = 1& To Len(strIn)
        Select Case Asc(Mid(strIn, lngStart, 1&))
        Case vbKeyA To vbKeyZ   'Upper case: insert a space.
            If boolWasSpace Or boolWasUpper Then
                strOut = strOut & Mid(strIn, lngStart, 1&)
            Else
                strOut = strOut & " " & Mid(strIn, lngStart, 1&)
            End If
            boolWasSpace = False
            boolWasUpper = True
            
        Case 95                 'Underscore: replace with space.
            If Not boolWasSpace Then
                strOut = strOut & " "
            End If
            boolWasSpace = True
            boolWasUpper = False
            
        Case vbKeySpace         'Space: output and set flag.
            If Not boolWasSpace Then
                strOut = strOut & " "
            End If
            boolWasSpace = True
            boolWasUpper = False
            
        Case Else               'Any other char: output.
            strOut = strOut & Mid(strIn, lngStart, 1&)
            boolWasSpace = False
            boolWasUpper = False
        End Select
    Next
    
    ConvertMixedCase = strOut
End Function

No comments:

Post a Comment