VBA - Parse Email Text to Access 2000 Class Instance

Question

I am now maintaining a legacy VBA/Access 2000 application for a client. They have a customer who emails orders with text that looks like this

Contact: Peggy Hill
Company: Arlen Residential Mortgage Finance Co
Address: 43456 South 18939 West, Suite 47995
City: Arlen City
ContactState: TX
ContactZip: 88888
Phone: 8019990000
Email: [email protected]

DateOrdered: 4/6/09
DateDue: 4/15/09

etc...

The application has a VBA class with all of attributes but no way to parse the data into the appropriate fields. My client wants a form into which they can paste the text out of the email, have it parse to fields for verification and then write to the db.

Issues/Facts:

1. Each value is set off with 'ValueName: " token
2. Depending on how the email clients mangle the string there may or may not be a CrLf at the end of each line.
3. Missing values will have just the token, no "" or empty space.

I'd like to create a CreateOrder(OrderText As String) function that would read the text from the form but I have no idea how to handle the parsing in VBA.
I started creating a 2D array with the tokens pre-entered, but that seems clunky since I have to read the next item in the array to figure out when to stop accepting data for the previous token.

Suggestions?

Answer 1

This is fairly minimalistic; please add your own error checking. Need to add a reference to the "Microsoft Scripting Runtime"

Public Function Parse(msg As String) As Dictionary
   Dim i As Integer, pos As Integer
   Dim line As Variant
   Dim lines() As String
   Dim dict As New Dictionary

   lines = Split(msg, vbCrLf)
   For Each line In lines()
      pos = InStr(1, line, ":", vbTextCompare)
      If pos <> -1 Then
        dict.Add Trim$(Left$(line, pos - 1)), Trim$(Right$(line, Len(line) - pos))
      End If
   Next

   Rem: Access values like this (with null checks):
   Rem:    dict("Contact"), dict("Address")

   Set Parse = dict

End Function

I used it by creating a simple form with a textbox and button, and added this to the button click event:

Private Sub Command2_Click()
    Dim dict As Dictionary

    Text0.SetFocus
    Set dict = Parse(Text0.text)

    Debug.Print dict("Contact"), dict("Address")

    Rem clear up when done
    Set dict = Nothing

End Sub