Function NameSplit(ByVal FullName As String, ByVal lType As Long) As String
Dim tmpArr, arr(), Item1 As String, Item2 As String, Item3 As String, i As Long, n As Long
On Error Resume Next
FullName = Trim(FullName)
If Len(FullName) Then
tmpArr = Split(FullName, " ")
Item3 = tmpArr(UBound(tmpArr))
Item1 = tmpArr(0)
Select Case lType
Case 1: NameSplit = IIf(UBound(tmpArr) > 0, Item1, "")
Case 2
If UBound(tmpArr) > 1 Then
For i = 1 To UBound(tmpArr) - 1
If Len(Trim(CStr(tmpArr(i)))) > 0 Then
n = n + 1
ReDim Preserve arr(1 To n)
arr(n) = Trim(CStr(tmpArr(i)))
End If
Next
If n Then NameSplit = Join(arr, " ")
End If
Case 3: NameSplit = Item3
End Select
End If
End Function
Function arrNameSplit(ByVal SourceArray, ByVal lType As Long)
Dim tmpArr, arr(), lDim As Long, i As Long, j As Long, tmp As String
On Error Resume Next
tmpArr = SourceArray
If TypeName(tmpArr) <> "Variant()" Then
arrNameSplit = NameSplit(tmpArr, lType)
Else
lDim = Dimensions(tmpArr)
If lDim < 3 Then
If lDim = 1 Then
For i = LBound(tmpArr) To UBound(tmpArr)
tmp = tmpArr(i)
tmpArr(i) = NameSplit(tmp, lType)
Next
Else
For i = LBound(tmpArr, 1) To UBound(tmpArr, 1)
For j = LBound(tmpArr, 2) To UBound(tmpArr, 2)
tmp = tmpArr(i, j)
tmpArr(i, j) = NameSplit(tmp, lType)
Next
Next
End If
End If
arrNameSplit = tmpArr
End If
End Function
Private Function Dimensions(ByVal SourceArray) As Long
Dim chkDim As Long, lDim As Long, tmpArr
On Error Resume Next
tmpArr = SourceArray
If IsArray(tmpArr) Then
Do While Err.Number = 0
lDim = lDim + 1
chkDim = LBound(tmpArr, lDim)
Loop
Dimensions = lDim - 1
End If
End Function
