Just paste this code into any module (this is the desired way) or form. To do this, open up your project and insert a new Module. Change the name of the module to basStrings and paste this code into the module.
'----------------------------------------------------------------------
'
' Module Name: basStrings
' Written By: C&D Programming Corp.
' Create Date: 11/19/97
' Copyright: Copyright 1997 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
'
' Purpose: Converting a single delimited string into an
' array.
'
'----------------------------------------------------------------------
Public Sub StringToGenericArray(sData As String, vArray As Variant, ByVal sDelimiter As String)
Dim lDelimLen As Long
Dim lLastPos As Long
Dim lPos As Long
Dim lCount As Long
On Error Goto Handler
' Redim a bunch of elements for speed
ReDim vArray(1 To 100)
lDelimLen = Len(sDelimiter)
' put delimiter at end if it is not already there.
If Right(sData, lDelimLen) <> sDelimiter Then
sData = sData & sDelimiter
End If
lLastPos = 1
lCount = 1
lPos = InStr(lLastPos, sData, sDelimiter)
' While we still find delimiters loop through each
' element of the string.
While lPos <> 0
' If we reached UBound elements then redim the
' array and preserve what we had. Add 25
' new elements for speed purposes. It is
' much faster to add 25 elements once
' than added 1 element 25 times.
If lCount > UBound(vArray) Then
ReDim Preserve vArray(1 To lCount + 25)
End If
vArray(lCount) = Trim$(Mid$(sData, lLastPos, lPos - lLastPos))
lCount = lCount + 1
lLastPos = lPos + lDelimLen
lPos = InStr(lLastPos, sData, sDelimiter)
Wend
' If we found no elements, return an empty array.
' Otherwise get rid of the extra elements.
If lCount = 1 Then
Erase vArray
vArray = Empty
Else
ReDim Preserve vArray(1 To lCount - 1)
End If
End Sub
Handler:
vArray = Empty
Err.Raise Err.Number, "basStrings.StringToGenericArray", Err.Description
End Sub