动态解析工作表中单元格中的文本

Question

我正在为我的一位同事编写一个小的 Excel VBA/公式表。 该部门将为员工举办“减肥挑战”。

我有一个 vba 代码来提取电子邮件信息以查找这些字段

`ColumnA = Subject Line
ColumnB = Date of e-mail
ColumnC = Sender
ColumnD = Text of e-mail body`

我正在努力从电子邮件正文中解析/提取某些文本。 员工被指示以这种格式填写他们的电子邮件：

`Associate Name: Test McTesterson
Associate E-mail: Tmctesterson@gmail.com
AIN: 123456
Weight: 200`

除了 WEIGHT 之外，我几乎可以获取所有内容。这是因为在进行“MID”搜索的权重之后没有“标识符”，并且使用 RIGHT 会返回包括电子邮件签名和标签在内的所有内容。

有没有办法搜索/查找 Weight: 然后只获取前 5-7 个字符，包括空格？

搜索电子邮件并将其拉入 excel 的代码。

`Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer`
`Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set Folder = 
OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("inital weigh 
in")`
`i = 1`
`For Each OutlookMail In Folder.Items
If OutlookMail.ReceivedTime >= Range("From_date").Value Then
Range("eMail_subject").Offset(i, 0).Value = OutlookMail.Subject
Range("eMail_date").Offset(i, 0).Value = OutlookMail.ReceivedTime
Range("eMail_sender").Offset(i, 0).Value = OutlookMail.SenderName
Range("eMail_text").Offset(i, 0).Value = OutlookMail.Body`
`i = i + 1
End If
Next OutlookMail`
`Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing`

这会带来这样的电子邮件：

`subject    = Initial Weigh In
date = 8/12/2019 9:59   
sender = Test McTesterson
text = "Associate Name: Test McTesterson`
`Associate E-mail: Tmctesterson@gmail.com
AIN: 12345
Weight: 221 
Test McTesterson
Director | Clinical Process Transformation
“Everything should be made as simple as possible, but not one bit 
simpler.” – Albert Einstein`

我正在使用公式来解析文本。 要获取我使用的关联名称 = MID(D2,SEARCH("Associate Name:",D2)+16, SEARCH("Associate E-mail:", D2)-SEARCH("Associate Name:", D2)-16)
这按预期工作

获取我使用的同事电子邮件 =MID(D2,SEARCH("Associate E-mail:",D2)+17,SEARCH("AIN:",D2)- SEARCH("Associate Name:",D2)-50) 这有效，但偶尔会有一些额外的字符

为了获得我使用的 AIN =MID(D2,SEARCH("AIN:",D2)+4, SEARCH("Weight:", D2)-SEARCH("AIN:", D2)-4) 这大多是正确的

要获得我尝试使用的重量 =RIGHT(D2, SEARCH("weight:",D2)+1) 这不起作用

这是解析此类文本的最佳方法吗？如果是这样.. 有没有办法让我得到重量：不抓住发件人的签名和电子邮件标签？

Answer 1

也许你可以搜索Weight:（或LCase("weight")，这样会更好）找到开头，找出结尾字符是什么，然后取其间的所有内容。很可能是CHR(13) 或CHR(13) & CHR(10) 或类似的东西。也许是这样的？

Dim Body As String, Start As Integer, LineEnd as Integer
Body = OutlookMail.Body 'This is just to shorten the name
Start = InStr(LCase(Body), "weight:") + 7
LineEnd = InStr(Start, Body, vbNewLine)
Weight = Mid(Body, Start, LineEnd - Start)

如果你想把它作为一个公式而不是让宏为你解析它，你可以使用SEARCH而不是InStr和MID来制作一个复杂的公式，但是除非你使用，否则公式会很长隐藏列中的单元格来存储子公式。实际上，公式应该是这样的：

在重量列中：

MID(D2,SEARCH("Weight:",D2)+7,SEARCH(CHAR(13)&CHAR(10),D2,SEARCH("Weight:",D2)+7)-SEARCH("Weight:",D2)+7)