Excel VBA：帮助在Excel中编辑outlook电子邮件解析器

我一直在尝试创建一个电子邮件解析器，让excel在指定的特定文件夹中检查我的outlook电子邮件。下面的代码很好用，我在另一个论坛上修改了它，除了一个问题：在我试图解析的电子邮件中，底部部分可以包含多个项目。基本上，我需要对单词“item”的每一个实例重复这些步骤，但是下一个项目及其相关的sku、数量和成本

因此，当处理完一封电子邮件并转到下一封时，在excel中应该是这样的：

传真、日期、客户1、客户地址1、项目1、sku1、qty1、成本1

传真，日期，客户1，客户地址1，项目2，sku2，qty2，成本2

传真，日期，客户2，客户地址2，项目1，sku1，qty1，成本1

有没有办法做到这一点

下面是我当前的代码，但它只显示了产品的第一个实例、sku、数量和成本，然后转到下一封电子邮件

        Dim msgText As String
        Dim msgLine() As String
        Dim messageArray() As String

        i = 0

        For Each myOlMailItem In myOlFolder.Items


            i = i + 1                                    ' first parsed message ends up on worksheet one row below headings

            msgText = myOlMailItem.Body

            messageArray = Split(msgText, vbCrLf)        ' split into lines

            For j = 0 To UBound(messageArray)


                msgLine = Split(messageArray(j) & ":", ":")  ' split up line ( add ':' so that blank lines do not error out)

                Select Case Left(msgLine(0), 3)
                    Case "FAX"
                        anchor.Offset(i, 0).Value = msgLine(1)
                    End Select

                Select Case Left(msgLine(0), 4)
                    Case "DATE"
                        anchor.Offset(i, 1).Value = msgLine(1)
                    End Select

                Select Case Left(msgLine(0), 6)
                    Case "CUSTOM"
                        anchor.Offset(i, 2).Value = msgLine(1)
                    End Select

                Select Case Left(msgLine(0), 6)
                    Case "CUSTOM"
                        anchor.Offset(i, 3).Value = messageArray(j + 1) + messageArray(j + 2) + messageArray(j + 3)
                    End Select

                Select Case Left(msgLine(0), 4)
                    Case "ITEM"
                        anchor.Offset(i, 4).Value = msgLine(1)
                    End Select

                Select Case Left(msgLine(0), 3)
                    Case "SKU"
                        anchor.Offset(i, 5).Value = msgLine(1)
                    End Select

                Select Case Left(msgLine(0), 8)
                    Case "QTY"
                        anchor.Offset(i, 6).Value = msgLine(1)
                    End Select

                Select Case Left(msgLine(0), 4)
                    Case "COST"
                        anchor.Offset(i, 7).Value = msgLine(1)
                    End Select

            Next

                anchor.Offset(i, -1).Value = myOlMailItem.SenderName
                                        ' add row number on left of "Priority" column (make sure that "anchor" is not in first worksheet column)

            Next
    End Sub

电子邮件如下所示。他们可以订购不同数量的物品。下面的模板显示了3个不同项目的显示方式

DATE                 : 12/01/2018
------------------------------------------------------------                    
CUSTOMER             : CUSTOMER NAME
                     : ADDRESS
                     : ADDRESS
                     : ADDRESS
PHONE                : PHONE
FAX                  : FAX
------------------------------------------------------------                    
DELIVER TO           : DELIVER TO CUSTOMER
                     : ADDRESS
                     : ADDRESS
                     : ADDRESS
------------------------------------------------------------                                                                                                                                                                  
ITEM NAME            : ITEM NAME
SKU                  : SKU
QTY                  : QTY #
COST                 : COST $
------------------------------------------------------------                    
ITEM NAME            : ITEM NAME
SKU                  : SKU
QTY                  : QTY #
COST                 : COST $
------------------------------------------------------------                   
ITEM NAME            : ITEM NAME
SKU                  : SKU
QTY                  : QTY #
COST                 : COST $
------------------------------------------------------------                    

---

这会让你接近：

Dim keyValuePairs() As String       ' Fields extracted from the e-mail
Dim messageLines() As String        ' Individual Lines in the e-mail
Dim itemList() As String            ' List of Item information in a single e-mail
                                    ' (0, n) = Item Name of Item n
                                    ' (1, n) = SKU of Item n
                                    ' (2, n) = Quantity of Item n
                                    ' (3, n) = Cost of Item n

Dim currentItem As Integer          ' Index for looping through customer item list
Dim customerName As String          ' Customer Name
Dim customerAddress As String       ' Customer Address
Dim customerPhone As String         ' Customer Phone Number - Currently Ignored
Dim customerFax As String           ' Customer Fax Number
Dim deliveryName As String          ' Delivery Customer Name - Currently Ignored
Dim deliveryAddress As String       ' Delivery Address - Currently Ignored
Dim messageLine As Integer          ' Index for walking through message lines
Dim orderDate As String             ' Date of Order
Dim parseState As String            ' Manages which address is being parsed
Dim targetExcelRow As Integer       ' Excel row on which to place data
Dim itemCount As Integer            ' Number of items in a single e-mail
Dim itemValue As String              ' Trimmed value

targetExcelRow = 1          ' Start placing items on the first row below headings

' Loop through e-mails
For Each myOlMailItem In myOlFolder.Items

    ' Set up for a New Message
    messageLines = Split(myOlMailItem.Body, vbCrLf)  ' Split the message body into lines
    itemCount = -1                                   ' Reset the item count
    ReDim itemList(3, 0)                             ' Reset the item list
    customerName = ""                                ' Reset all static values
    customerAddress = ""
    customerFax = ""
    customerPhone = ""
    orderDate = ""
    deliveryName = ""
    deliveryAddress = ""

    ' Loop through the lines in the e-mail
    For messageLine = 0 To UBound(messageLines)

        ' Array is expected to have only two values per line.
        ' Position 0 is the Key. Position 1 is the Value.
        keyValuePairs = Split(messageLines(messageLine), ":")

        If UBound(keyValuePairs) > 0 Then   ' This ignores blank lines and dividers
            itemValue = Trim$(keyValuePairs(1))
            Select Case Trim$(keyValuePairs(0))
                Case "DATE"
                    orderDate = itemValue
                    parseState = ""
                Case "CUSTOMER"
                    customerName = itemValue
                    parseState = "CUSTADDR"
                Case "FAX"
                    customerFax = itemValue
                Case "DELIVER TO"
                    deliveryName = itemValue
                    parseState = "DELIVADDR"
                Case "ITEM NAME"
                    itemCount = itemCount + 1
                    ReDim Preserve itemList(3, itemCount)
                    itemList(0, itemCount) = itemValue
                Case "SKU"
                    itemList(1, itemCount) = itemValue
                Case "QTY"
                    itemList(2, itemCount) = itemValue
                Case "COST"
                    itemList(3, itemCount) = itemValue
                Case "PHONE"
                    customerPhone = itemValue
                Case ""    ' Handle blank field names
                    Select Case parseState
                        Case "CUSTADDR"
                            customerAddress = customerAddress + itemValue
                        Case "DELIVADDR"
                            deliveryAddress = deliveryAddress + itemValue
                        Case Else   ' Error: Unhandled State
                            'Debug.Print "Unhandled blank field encountered at message line " & Trim$(CStr(j + 1)) & "."
                            Err.Raise Number:=vbObjectError, _
                                      source:="E-Mail Parse Function", _
                                      Description:="Unhandled blank field encountered at message line " & Trim$(CStr(j + 1)) & "."
                    End Select

                Case Else
                    'Debug.Print "Unhandled keyword encountered at message line " & Trim$(CStr(j + 1)) & "."
                    Err.Raise Number:=vbObjectError, _
                              source:="E-Mail Parse Function", _
                              Description:="Unhandled keyword encountered at message line " & Trim$(CStr(j + 1)) & "."
            End Select

        End If

    Next messageLine

    ' Now write the data to the Excel Sheet

    For currentItem = 0 To itemCount
        With anchor
            .Offset(targetExcelRow, -1).Value = myOlMailItem.SenderName ' SenderName of Priority Column
            .Offset(targetExcelRow, 0).Value = customerFax              ' Fax Number
            .Offset(targetExcelRow, 1).Value = orderDate                ' Order Date
            .Offset(targetExcelRow, 2).Value = customerName             ' Customer Name
            .Offset(targetExcelRow, 3).Value = customerAddress          ' Customer Address
            .Offset(targetExcelRow, 4).Value = itemList(0, currentItem) ' Item Name
            .Offset(targetExcelRow, 5).Value = itemList(1, currentItem) ' SKU
            .Offset(targetExcelRow, 6).Value = itemList(2, currentItem) ' Quantity
            .Offset(targetExcelRow, 7).Value = itemList(3, currentItem) ' Cost
        End With
        targetExcelRow = targetExcelRow + 1
    Next currentItem

Next myOlMailItem

如果您希望系统将未处理的内容打印到即时窗口，请取消注释

Debug.Print

行，并注释

Err.Raise

行。我仅使用您提供的示例数据对这段代码进行了一次循环测试。对于任何数量的电子邮件，它都可以正常工作

注意事项：

• 您的原始代码为每个案例调用了一个单独的

  Select Case

  语句。这完全没有必要。我已经巩固了它们
• 如果使用一个用于项目信息的类和一个用于客户信息的类来实现，这将更加简洁。我把它留给你做练习
• 我没有对此进行全面测试，只是部分测试。您可能需要进行一些边缘条件测试或特殊情况测试
• 主要的想法是，你可以先收集你所有的信息，然后将其写入电子表格
• 在我的测试中，我通过了

  anchor

  作为参数。代码假定已定义并设置了锚点
• 此代码检索送货信息和客户电话号码，即使它们未被使用。我想，为什么不呢

• parseState

  用于管理行中没有字段名来标识数据的情况。

  Case”“

  语句处理这些情况中的任何一种。<代码> PARSESTATAON/COD>变量告诉该如何处理空白行。因此，当您遇到<代码>客户>代码>字段时，它将<代码> PARSESTATE 设置为“CuSTADDR”，以让空白字段实例知道它正在解析客户地址。

---

祝你好运

你能提供一个输入体样本吗？请将其粘贴在代码上方或下方，并用代码大括号将其框起来，以保留其格式和间距。若有变化，那个么也显示它们。我已经输入了一个电子邮件模板。订购的项目数量是可变的。无论订购了多少项，它们都将始终以这种格式显示@Donpabloi有些代码丢失了吗？您有三个

For

语句，只有两个

Next

语句。除非我遗漏了什么，否则代码甚至不会运行。示例输入和输出中都没有“产品名称”。然而，该代码有一个基于PN的FOR循环。请以某种方式更正以上内容以使其清楚。这四个明细行是否始终存在于该订单中（项目名称/SKU/数量/成本）？？如果是这样的话，我们能找到第一个并索引它吗+1，+2，+3？？？@donPablo很抱歉，我正在测试我的代码，并认为我已经删除了我的测试项目，比如“产品名称”部分。我已经删除了代码中的“产品名称”部分。这非常棒，而且肯定会清理掉我的许多原始代码。非常感谢你！我已将其标记为已回答！