String VBA-解析电子邮件文本以访问2000类实例

我现在正在为客户机维护一个遗留的VBA/Access 2000应用程序。他们有一个客户，他通过电子邮件发送订单，上面的文字如下

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: peggy.hill@arlenmortgage.com

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

等等

应用程序有一个VBA类，该类具有所有属性，但无法将数据解析到适当的字段中。我的客户需要一个表单，他们可以将电子邮件中的文本粘贴到表单中，将其解析到字段进行验证，然后写入数据库

问题/事实：

每个值都用“ValueName:”标记进行抵销

根据电子邮件客户端对字符串的处理方式，每行末尾可能有一个CrLf，也可能没有

缺少的值将只有标记，没有“”或空白

我想创建一个

CreateOrder（OrderText作为字符串）

函数，从表单中读取文本，但我不知道如何在VBA中处理解析。
我开始用预先输入的令牌创建一个2D数组，但这似乎很笨拙，因为我必须读取数组中的下一项，以确定何时停止接受前一令牌的数据

---

建议？

这相当简单；请添加您自己的错误检查。需要添加对“Microsoft脚本运行时”的引用

---

非常好！我完全忘记了FSO中有一个Dictionary对象。我认为，最好使用带有后期绑定的FSO，以避免添加只用于一段代码的引用。

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

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