Option Explicit
Option Base 1 Public Function ConvertListToArray(ArgList As String, ArgDelimiter As String, Optional MaxArgs As Integer) 'make sure ArgDelimiter = 1 character, will not work otherwise ArgDelimiter = Mid$(ArgDelimiter, 1, 1) 'Declare variables. Dim C As String, ArgListLen As Integer, InArg As Boolean, i As Integer, NumArgs As Integer, ArgArray() As String 'See if MaxArgs was provided. If MaxArgs = 0 Then MaxArgs = GetNumArgsInList(ArgList, ArgDelimiter) 'Make array of the correct size. ReDim ArgArray(MaxArgs) NumArgs = 0: InArg = False 'Get argument list arguments. ArgListLen = Len(ArgList) 'Go thru argument list one character at a time. If ArgListLen >= 1 Then For i = 1 To ArgListLen C = Mid(ArgList, i, 1) 'Test for ArgDelimiter If (C <> ArgDelimiter) Then 'Not ArgDelimiter Test if already in argument. If Not InArg Then 'New argument begins. Test for too many arguments. If NumArgs = MaxArgs Then Exit For NumArgs = NumArgs + 1 InArg = True End If 'Concatenate character to current argument. ArgArray(NumArgs) = ArgArray(NumArgs) & C Else 'Found ArgDelimiter 'Set InArg flag to False. InArg = False End If Next i End If 'Resize array just enough to hold arguments. ReDim Preserve ArgArray(NumArgs) For i = LBound(ArgArray) To UBound(ArgArray) ArgArray(i) = Trimmer(ArgArray(i)) Next i 'Return Array in Function name. ConvertListToArray = ArgArray() End Function Private Function GetNumArgsInList(ArgList As String, ArgDelimiter As String) As Integer Dim Pos As Long Dim LastPos As Long Dim Count As Integer Pos = InStr(1, ArgList, ArgDelimiter, vbBinaryCompare) If Pos = 0 Then GetNumArgsInList = 1 Exit Function Else Count = 0 Do Pos = InStr(LastPos + 1, ArgList, ArgDelimiter, vbBinaryCompare) LastPos = Pos Count = Count + 1 Loop Until Pos = 0 GetNumArgsInList = Count End If End Function |