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: [phone] Email: [e-mail]  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