Text Parsing

I have a flat data file that looks like this:

Domain\Aaron.Hack.1 (Aaron Hack)
email aaron.hall.1@tony.com
phone 5154934589
Domain\Frank.Smith (Frank Smith)
email frank.smith@tony.com

Domain\Judy.Smith.7 (Judy Smith)
email Judy.Smith@tony.vom
phone 2605551234
phone 2605551243

I want to produce:  Name,Email1,Email2,phone,phone in a .csv or Access table.  I used to utilize Monarch, but can't load it any longer (not approved by corporate).  Is there a similar tool on the shareware market?
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Ariful AmbiaHead of MISCommented:
Try ms excel data import option.
TIgerVAuthor Commented:
Since there is not a significant delimiter or number of rows, excel data import is not a good solution for this file.  


Bring the text into a Word document.


Issue the following three Find Replace All commands:



Open in new window


Tweak the result for the first and last record.* Insert a quote character at the start of the very first line
* change the final "," sequence to a single quote character

You can save this as CSV or copy/paste it into Notepad for saving as CSV.  If you want to copy/paste it directly into Access, you would use a tab instead of a comma.

If you make this text into a Word table, you might also be able to directly import it into Access or Excel (treat it like a proper data source).
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

You could use vb or try the following.

Here are some products that look similar:
Yes.  It is possible to do that conversion with VB/VBScript code, using the Replace() function.
Patrick MatthewsCommented:
This was actually very easy to do using classes.

1) Add this code to a class module, and rename the class module clsPeople:

' Created by Patrick Matthews, Verint Systems
' Created 2011-10-31

' Parent collection class of clsPerson

Option Explicit
Option Compare Text

' Container for all clsPerson objects in the parent collection class
Private coll As Collection

Private Sub Class_Initialize()
    Set coll = New Collection
End Sub

Private Sub Class_Terminate()
    Set coll = Nothing
End Sub

Public Function Add(Domain As String) As clsPerson
    ' Adds a new item to the collection.  Causes an error if an item with the same key already exists
    ' or if you pass a zero length string for the Domain argument
    If Domain = "" Then
        Err.Raise vbObjectError + 1002, , "Domain property of clsPerson object cannot be zero length string"
    End If
    Set Add = New clsPerson
    Add.Domain = Domain

    ' Raise an error and set return value to Nothing if we fail to add item to collection (most likely
    ' because an item already exists with the same key
    On Error GoTo ErrHandler
    coll.Add Add, Domain

    Exit Function

    Set Add = Nothing
    Err.Raise vbObjectError + 1003, , "Could not add item '" & Domain & "' to clsPeople collection"
End Function

Public Sub Clear()
    ' Recreates (and thus clears) collection
    Set coll = New Collection
End Sub

Property Get Count() As Long
    ' Returns number of items in the collection
    ' Read-only
    Count = coll.Count
End Property

Function Exists(Domain As String) As Boolean

    ' Returns True if a clsPerson member specified by the Domain exists in clsPeople parent collection

    Dim TempItem As clsPerson

    On Error GoTo CleanUp

    ' Default return is False
    Exists = False

    ' If item exists, then the Set operation completes without error
    Set TempItem = coll(Domain)
    Exists = True


    Set TempItem = Nothing

End Function

Function Export()
    Dim Person As clsPerson
    Dim DestR As Long
    [a1:e1] = Array("Name", "Email1", "Email2", "Phone1", "Phone2")
    [d:e].NumberFormat = "@"
    DestR = 1
    For Each Person In Me
        DestR = DestR + 1
        With Person
            Cells(DestR, 1) = .Name
            Cells(DestR, 2) = .Email1
            Cells(DestR, 3) = .Email2
            Cells(DestR, 4) = .Phone1
            Cells(DestR, 5) = .Phone2
        End With
End Function

Function Import() As Boolean
    Dim LastR As Long
    Dim arr As Variant
    Dim Counter As Long
    Dim Person As clsPerson
    Dim TestStr As String
    Import = False
    On Error GoTo ErrHandler
    With ActiveSheet
        LastR = .Cells(.Rows.Count, "a").End(xlUp).Row
        arr = .Range("a1:a" & LastR).Value
    End With
    For Counter = 1 To UBound(arr, 1)
        TestStr = arr(Counter, 1)
        If TestStr Like "domain*" Then
            Set Person = Me.Add(TestStr)
            Person.Name = Mid(Person.Domain, InStr(1, Person.Domain, "(") + 1)
            Person.Name = Left(Person.Name, Len(Person.Name) - 1)
        ElseIf TestStr Like "email*" Then
            If Person.Email1 = "" Then
                Person.Email1 = Mid(TestStr, InStr(1, TestStr, " ") + 1)
                Person.Email2 = Mid(TestStr, InStr(1, TestStr, " ") + 1)
            End If
        ElseIf TestStr Like "phone*" Then
            If Person.Phone1 = "" Then
                Person.Phone1 = Mid(TestStr, InStr(1, TestStr, " ") + 1)
                Person.Phone2 = Mid(TestStr, InStr(1, TestStr, " ") + 1)
            End If
        End If
    Import = True
    Set Person = Nothing
End Function

Property Get Item(Index As Variant) As clsPerson
    ' Default property.  Returns an item from the collection.  Index may be either ordinal position (Long) or Domain (String)
    ' Read-only
    On Error GoTo ErrHandler
    Set Item = coll(Index)

    Exit Property


    Set Item = Nothing
    Err.Raise vbObjectError + 1004, , "Item does not exist in clsPeople collection"
End Property

Function Keys() As Variant

    ' Returns a 1-based array of the various strings used as Domain key values for the clsPerson items
    ' in the clsPeople collection"

    Dim Counter As Long
    Dim Results() As String

    ' If there are no items in the clsPeople collection then raise an error
    If Me.Count > 0 Then

        ' Redimension array so there is one member per clsPerson item in clsPeople collection
        ReDim Results(1 To Me.Count) As String

        ' Loop through clsPeople collection and grab Domain values for each clsPerson item
        For Counter = 1 To Me.Count
            Results(Counter) = Me(Counter).Domain

        ' Set return value
        Keys = Results


        ' Raise error for no items
        Err.Raise vbObjectError + 1005, , "Keys method failed: no clsPerson items exist in clsPeople collection"

    End If

End Function

Public Sub Remove(Index As Variant)
    ' Removes an item from the collection.  Index may be either ordinal position (Long) or Domain (String)
    coll.Remove Index
End Sub

Function NewEnum() As IUnknown

    ' Enables enumeration of the clsPeople parent collection, i.e.:
    ' For Each Child In Parent...Next
    Set NewEnum = coll.[_NewEnum]

End Function

Open in new window

2) Add this to another class module, and name it clsPerson

' Created by Patrick Matthews, Verint Systems
' Created 2011-10-31

Option Explicit
Option Compare Text

' Container for "write-once read-many" property
Private Safe_Domain As String

Public Name As String
Public Email1 As String
Public Email2 As String
Public Phone1 As String
Public Phone2 As String

Property Get Domain() As String
    ' Returns item's Domain value
    Domain = Safe_Domain
End Property

Property Let Domain(DomainString As String)
    ' Sets Domain value for item
    ' This makes the Domain property "write once, read many".  If the Domain is a zero length string,
    ' the Property Let allows you to change it; if not, the procedure raises a user defined
    ' error.  Basically, we cannot allow changes because we want this property to match the
    ' item's true key used when it was added to the parent clsPeople collection
    If Safe_Domain = "" Then
        Safe_Domain = DomainString
        Err.Raise vbObjectError + 1001, , "Cannot change Domain property of clsPerson object"
    End If
End Property

Open in new window

3) Put this in a regular module:

Option Explicit

Sub RunIt()
    Dim Peeps As clsPeople
    Set Peeps = New clsPeople
    With Peeps
    End With
    Set Peeps = Nothing
End Sub

Open in new window

Seems like a lot of code, but nearly all of it was generated automatically by my Parent Class Builder add-in, available at http://www.experts-exchange.com/A_3802.html

Sample file included

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Patrick,  that rocks!
It looks like you have some solutions from others. For what it's worth here is a VBScript to parse this into a .CSV file. Change the first two variables to the path to your input file and the desired output file path respectively.

strInputFilePath = "c:\temp\data.txt"
strOutputFilePath = "c:\temp\output.csv"

Const ForReading = 1
Const ForWriting = 2
intEmail = 1
intPhone = 1

Set objFso = CreateObject("Scripting.FileSystemObject")
Set objInputFile = objFso.OpenTextFile(strInputFilePath, ForReading, False)
Set objOutputFile = objFso.OpenTextFile(strOutputFilePath, ForWriting, True)

''Initialize the dictionary object
Set objDataDict = CreateObject("Scripting.Dictionary")
objDataDict.Item("Name") = ""
objDataDict.Item("Email1") = ""
objDataDict.Item("Email2") = ""
objDataDict.Item("Phone1") = ""
objDataDict.Item("Phone2") = ""

objOutputFile.WriteLine Join(objDataDict.Keys(), ",")

Do While Not objInputFile.AtEndOfStream
	blnProc = False
	strText = Trim(objInputFile.Readline)
	Select Case True
		Case Trim(strText) = ""
			ReDim aryLineValues(4)
			intEmail = 1
			intPhone = 1
			objOutputFile.WriteLine Join(objDataDict.Items(), ",")
			For Each strKey In objDataDict.Keys()
				objDataDict.Item(strKey) =  ""
			blnProc = True
		Case InStr(1, strText, "Domain\", 1) > 0
			strValue = Replace(Right(strText, Len(strText) - InStr(strText, "(")), ")", "")
			objDataDict.Item("Name") = strValue
		Case InStr(1, strText, "email", 1) > 0
			objDataDict.Item("Email" & CStr(intEmail)) = Trim(Replace(UCase(strText), "EMAIL", ""))
			intEmail = intEmail + 1
		Case InStr(1, strText, "phone", 1) > 0
			objDataDict.Item("Phone" & CStr(intPhone)) = Trim(Replace(UCase(strText), "PHONE", ""))
			intPhone = intPhone + 1
	End Select
If Not blnProc Then
	objOutputFile.WriteLine Join(objDataDict.Items(), ",")
End If


Open in new window

Patrick MatthewsCommented:
Thanks, Dave!

That Parent Class Builder add-in makes it really, really easy to implement class module solutions :)

It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.