excel - Excel VBA：帮助在 Excel 中编辑 Outlook 电子邮件解析器
问题描述
我一直在尝试创建一个电子邮件解析器，它让 excel 在特定的指定文件夹中浏览我的 Outlook 电子邮件。下面的代码效果很好，我从另一个论坛修改了它，除了一个问题：在我试图解析的电子邮件中，底部可以包含多个项目。我基本上需要这个来为“item”这个词的每个实例重复这些步骤，但要使用下一个 item 及其相关的 sku、qty 和 cost。
因此，当它处理完一封电子邮件并转到下一封时，它在 excel 中应该如下所示：
传真, 日期, cust1, cust address1, item1, sku1, qty1, cost1
传真, 日期, cust1, cust address1, item2, sku2, qty2, cost2
传真, 日期, cust2, cust address2, item1, sku1, qty1, cost1
有没有办法做到这一点？
下面是我当前的代码，但它只显示了产品的第一个实例、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 ""声明处理任何这些情况。该parseState变量告诉这种情况如何处理空行。因此，当您遇到该CUSTOMER字段时，它将设置parseState为“CUSTADDR”以让空白字段案例知道它正在解析客户地址。
祝你好运！
推荐阅读
- r - 如何将 XY-RGB 数据帧转换为图像 [cimg 类型]
- excel - excel如何使用索引和匹配来匹配数据
- excel - 使用来自数据库和 Excel 的数据源开发 SSRS 报告
- reactjs - Flask 和 React - 在 Spotify 授权后处理令牌
- angular - Angular 9 中的 OAuth
- c# - Masstransit 6.2.3 中的 rabbitmq AlreadyClosedException
- c - C添加非内联函数时乘以符号错误
- sql - oracle sql如何批量选择
- css - 检查输入时如何将 css 应用于父级的兄弟元素？
- python - 使 print(df['ID'].value_counts()) 打印包含 100 个类别的列的所有类别