Source code for Issue Number 23

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Just paste this code into any module and change the name to basStrings. If you have one of our previous string handling routines, place it in there.

'----------------------------------------------------------------------
'
'   Module Name:    basStrings
'   Written By:     C&D Programming Corp.
'   Create Date:    5/7/97
'   Update Date:    3/10/99
'   Copyright:      Copyright 1998 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'   Changes:        Now supports a delimiters greater than a single
'                   character.
'----------------------------------------------------------------------

Function GetWord(sData As String, iWord As Integer, sDelim As String) As String
    Dim iPos As Long
    Dim iPos2 As Long
    Dim iCount As Long

    On Error GoTo GetWordErr
    iPos = InStr(sData, sDelim)
    If iPos = 0 Then
        ' if only first word requested then return whole string since
        ' delimiter was not found.  If a word number greater than
        ' one was asked for, we have not found it, so return an empty
        ' string.
        If iWord = 1 Then
            GetWord = sData
        Else
            GetWord = ""
        End If
        Exit Function
    End If

    ' if we got here we are at word number 2.
    iCount = 2

    ' keep search until we find the word number we
    ' want to return.
    While iCount < iWord
        iPos = InStr(iPos + Len(sDelim), sData, sDelim)
        If iPos = 0 Then
            GetWord = ""
            Exit Function
        End If
        iCount = iCount + 1
    Wend

    ' we should never need this case since it should be
    ' covered in the very first If statement, but, just in case
    ' something unexpected happens
    If iWord = 1 Then
        If iPos = 0 Then
            GetWord = sData
        Else
            GetWord = Mid$(sData, 1, iPos - 1)
        End If
    Else
        ' extract the word we want based on the occurence of
        ' the next delimiter, if there are no more delimiters, return
        ' the rest of the string, otherwise just return the delimited
        ' word.
        iPos2 = InStr(iPos + 1, sData, sDelim)
        If iPos2 = 0 Then
            GetWord = Mid$(sData, iPos + Len(sDelim))
        Else
            GetWord = Mid$(sData, iPos + Len(sDelim), iPos2 - iPos - Len(sDelim))
        End If
    End If
    Exit Function

GetWordErr:
    Err.Raise Err.Number, "GetWord", Err.Description
End Function