Daily Dose of Excel

Function ParseName(ByVal vFullName As Variant) As Variant
   
   Dim olCi As Object
   Dim rCell As Range
   Dim sFullName As String
   Dim olApp As Object   'Outlook.Application
   
   Dim bolRunning As Boolean
   Dim vItem As Variant
   Dim vAns() As String  'First, Middle, Last, Suffix
   Dim lCounter As Long
   
   Const olDISCARD As Long = 1
   Const olCONTACTITEM As Long = 2
   
   On Error Resume Next
   bolRunning = True
   Set olApp = GetObject(, "Outlook.Application")
   On Error GoTo 0
   If olApp Is Nothing Then
      Set olApp = CreateObject("Outlook.Application")
      bolRunning = False
   End If
   
   If TypeName(vFullName) = "Range" Then
      If vFullName.Count = 1 Then
         vFullName = Array(vFullName.Value)
      Else
         vFullName = vFullName
         vFullName = Application.Transpose(vFullName)
      End If
     
   ElseIf Not IsArray(vFullName) Then
      vFullName = Array(vFullName)
   End If
   
   
   ReDim Preserve vAns(1 To UBound(vFullName) - LBound(vFullName) + 1, 1 To 4)
   
   Set olCi = olApp.CreateItem(olCONTACTITEM)
   
   For Each vItem In vFullName
   
      olCi.FullName = vItem
     
      lCounter = lCounter + 1
     
      vAns(lCounter, 1) = olCi.firstname
      vAns(lCounter, 2) = olCi.MiddleName
      vAns(lCounter, 3) = olCi.LastName
      vAns(lCounter, 4) = olCi.Suffix
     
   Next vItem
   
   olCi.Close olDISCARD
   
   If Not bolRunning Then
      olApp.Quit
   End If
   
   Set olCi = Nothing
   Set olApp = Nothing
   
   ParseName = vAns
End Function