Excel VBA：协助在Excel中编辑Outlook电子邮件解析器

Question

I've been trying to create an email parser that has excel go through my outlook emails in a specific, designated folder. The code below works great, i modified it from another forum, except for one issue: in the emails i'm trying to parse, the bottom section can contain multiple items. I basically need this to repeat these steps for every instance of the word "item," but with the next item and its associated sku, qty, and cost.

So, when it's done with an email and moves on to the next, it should look like this in excel:

fax, date, cust1, cust address1, item1, sku1, qty1, cost1

fax, date, cust1, cust address1, item2, sku2, qty2, cost2

fax, date, cust2, cust address2, item1, sku1, qty1, cost1

Is there any way to do this?

Below is my current code, but it just shows the first instance of the product, sku, qty, and cost, and then moves on to the next email.

        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

The emails look like the below. They can have variable amounts of items ordered. The below template shows how 3 different items would appear.

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 $
------------------------------------------------------------                    

Answer 1

This should get you close:

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

If you prefer the system prints unhandled stuff to the immediate window, uncomment the Debug.Print lines and comment the Err.Raise lines. I have tested this code for one loop using only the sample data you provided. It should work fine for any number of e-mails.

Notes:

• Your original code invoked a separate Select Case statement for each case. that was completely unnecessary. I have consolidated them.
• This would be cleaner if implemented using a class for item information and a class for customer information. I leave that to you as an exercise.
• I did not do full testing on this, only partial. You may need to do some edge condition testing or special case testing.
• The main idea to take from this is that you can collect all your information first, then write it to the spreadsheet.
• In my trials, I passed anchor as a parameter. The code assumes that anchor has been defined and set.
• This code retrieves the delivery information and the customer phone number even though they are not used. I figured, Why not?
• The parseState is used for managing cases when there are no field names on the line to identify the data. The Case "" statement handles any of those cases. The parseState variable tells that case what to do with the blank line. So, when you encounter the CUSTOMER field, it sets the parseState to "CUSTADDR" to let the blank field case know that it is parsing the customer address.

Good Luck!