ConvListArray




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










( convlistarray.html )- by Paolo Puglisi - Modifica del 17/12/2023