删除电子邮件中某个string前后的文本（最多可达一个字）
我正在寻找创build一个VBAmacros（从Excel）search一个电子邮件与正文中的帐号，并删除该电子邮件中的所有其他表元素，除了我指定的元素的行。
例如，请参阅下面的附件。 假设我search的号码是“222222222222”号码。 我需要VBA代码来保留表头，删除所有不是“22222222222”（所有1111账户）的账户，同时也保持持有量。 是否有代码可以删除“2222222222”之后的所有文本，而是停止删除单词“Term”？ 在该标记上，可以在“截止date”一词之后开始删除，但在到达“222222 …”帐户时停止删除？
请让我知道，如果有任何方法我可以专注于实现这一点。
谢谢！
（PS这些电子邮件的长度不一，其中很多是每天收到的，另外，我已经有了可以通过search文本来search和打开电子邮件的代码，我只是无法弄清楚如何删除这些无关的东西我不在寻找。）
我附上了我的相关代码来search并打开下面的电子邮件：
Dim olApp As Outlook.Application Dim olNs As Namespace Dim Fldr As MAPIFolder Dim olMail As Outlook.MailItem Dim i As Integer Dim olMsg As Outlook.MailItem Dim r As Range Dim strLocation As String Dim o As Outlook.Application Dim strbody As String Dim objInspector As Object Set r = ActiveSheet.Buttons(Application.Caller).TopLeftCell Range(Cells(r.Row, r.Column), Cells(r.Row, r.Column)).Select Set olApp = New Outlook.Application Set olNs = olApp.GetNamespace("MAPI") Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders(" Notifications Macro") i = 1 For Each olMail In Fldr.Items If InStr(olMail.body, ActiveCell.Offset(rowOffset:=0, ColumnOffset:=-3).Value) <> 0 Then olMail.display If InStr(olMail.body, "Mandatory Event: No Responses Required for this") Then strbody = "<BODY style=font-size:11pt;font-family:Calibri>Team,<br><br>" & _ "Please see the notice below regarding " & _ ActiveCell.Offset(rowOffset:=0, ColumnOffset:=-2).Value & _ ".<br><br> This is for informational purposes and no action is required.<br><br>" & _ "Thank you!" With olMail.Forward .To = ActiveCell.Offset(ColumnOffset:=-1) .display SendKeys ("%") SendKeys ("7") 'Call Sleep Application.Wait (Now + TimeValue("0:00:03")) .HTMLBody = strbody & "<br>" & .HTMLBody .HTMLBody = Replace(.HTMLBody, ActiveCell.Offset(rowOffset:=0, ColumnOffset:=-3).Value, "<FONT style=" & Chr(34) & "BACKGROUND-COLOR: yellow" & Chr(34) & ">" & ActiveCell.Offset(rowOffset:=0, ColumnOffset:=-3).Value & "</FONT>") End With End If If InStr(olMail.body, "Warning: Response Required") Then strbody = "<BODY style=font-size:11pt;font-family:Calibri>Team,<br><br>" & _ "Please see the notice below regarding " & _ ActiveCell.Offset(rowOffset:=0, ColumnOffset:=-2).Value & _ ".<br><br> If the client wishes to make an election, they will need to call the corresponding team before the deadline indicated on the notice.<br><br>" & _ "Thank you!" With olMail.Forward .To = ActiveCell.Offset(ColumnOffset:=-1) .display SendKeys ("%") SendKeys ("7") 'Call Sleep Application.Wait (Now + TimeValue("0:00:03")) .HTMLBody = strbody & "<br>" & .HTMLBody .HTMLBody = Replace(.HTMLBody, ActiveCell.Offset(rowOffset:=0, ColumnOffset:=-3).Value, "<FONT style=" & Chr(34) & "BACKGROUND-COLOR: yellow" & Chr(34) & ">" & ActiveCell.Offset(rowOffset:=0, ColumnOffset:=-3).Value & "</FONT>") End With End If End If Next End Sub 代码可能看起来很混乱，但它只是search特定的Outlook文件夹中的包含特定值的邮件（在单元格A1 …在这种情况下… 222222222222），然后打开电子邮件，转发电子邮件和突出显示电子邮件中的帐号（2222222222）。
理想情况下，除了代码可以删除“2222222”号码后面的文本，直到达到“Term”一词为止，可以删除“22222222”帐号之前的所有文本，直到单词“Deadline”。 问题是，我还需要持有的数量，因为这个数字真的可以是任何事情，我很难想出如何做到这一点。 任何指导将不胜感激！
– 编辑 –
这里是“表”的代码，即使它没有实际显示表标签。 这是帐号出现的地方。 我把它们分别改为“111111”和“222222”。
</table> <div class="normalHeader xsmall" style="color:'CE0000'; background-color: white;"> Mandatory Event: No Responses Required for this event <br/> </div> <table width="98%" border="0" cellspacing="0" cellpadding="4"> <tr> <td> </td> </tr> <tr bgcolor="EEEEEE"> <td class="normalHeader medium" align="left" colspan="7"> Account Details </td> </tr> <tr bgcolor="EFEFEF"> <td class="normalHeader xsmallAlternate" style="background-color: #EFEFEF;"> Account </td> <td width="100"> </td> <td align="center" class="normalHeader xsmallAlternate" width="20%" nowrap="true" style="background-color: #EFEFEF;" colspan="3"> Holding Quantity </td> <td width="100"> </td> <td class="normalHeader xsmallAlternate" nowrap="true" style="background-color: #EFEFEF;"> Account Deadline </td> </tr> <tr class="xsmall"> <td nowrap="true"> 11111111111 </td> <td> </td> <td width="100"> </td> <td align="right" nowrap="true"> 25,000 </td> <td width="100"> </td> <td> </td> <td style="font-weight: bold;"> </td> </tr> <tr class="xsmall"> <td nowrap="true"> 11111111111 </td> <td> </td> <td width="100"> </td> <td align="right" nowrap="true"> 50,000 </td> <td width="100"> </td> <td> </td> <td style="font-weight: bold;"> </td> </tr> <tr class="xsmall"> <td nowrap="true"> 222222222222 </td> <td> </td> <td width="100"> </td> <td align="right" nowrap="true"> 50,000 </td> <td width="100"> </td> <td> </td> <td style="font-weight: bold;"> </td> </tr> <tr class="xsmall"> <td nowrap="true"> 111111111111 </td> <td> </td> <td width="100"> </td>
这是一个无赖，但并不奇怪，因为这里有很多事情要做。 让我们尝试一种不同的方法。 这是一个不涉及Excel或Outlook的例子。 为了清晰起见，我正在这样做，因为Excel和Outlook的东西正在扼杀作品。 我会让你决定如何把它插入你现有的function。
请摆脱我以前的任何代码，并在Excel中创build一个新的模块。 （假设你从代码的外观使用Excel）
将以下function粘贴到您的新模块中; 它只是返回一个模拟Outlook邮件项目的html正文的string。 表格格式与您提供的格式相同。
Function GetTestHTML() As String 'This respresents the e-mail's html body; use the e-mails html body for the real thing Dim strOut As String strOut = "<html><body>" strOut = strOut & "<div>Some Random Text in a div in made up html. Can be anything really.</div>" strOut = strOut & "<table>" strOut = strOut & "<tr><td> </td></tr>" 'first tr is just blank strOut = strOut & "<tr><td>Account Details</td></tr>" '2nd tr is 'Account Details' strOut = strOut & "<tr><td>Account</td><td>Holding Quantity</td><td>Account Deadline</td></tr>" '3rd tr is the column headers strOut = strOut & "<tr><td>11111111111</td><td>25,000</td><td> </td></tr>" 'here's the first real data row strOut = strOut & "<tr><td>11111111111</td><td>50,000</td><td> </td></tr>" strOut = strOut & "<tr><td>222222222222</td><td>50,000</td><td> </td></tr>" strOut = strOut & "<tr><td>333333333333</td><td>75,000</td><td> </td></tr>" strOut = strOut & "</table>" strOut = strOut & "</body></html>" GetTestHTML = strOut End Function
现在，请在上一个function的结束function之后，将以下内容粘贴到新模块中。 这包含将会进入您的主要function的variables和function，但您需要使用它来满足您的需求。 评论和MsgBoxes应该帮助确定发生了什么，所以你可以做到这一点。
Function TestHtmlTableReplace() Dim nTableStart As Long, nTableEnd As Long Dim strTableOrg As String, strTableNew As String Dim strHTMLBody As String Dim strAccount As String strAccount = "222222222222" 'this value represents current account number; use the excel range account number for the real thing strHTMLBody = GetTestHTML 'This respresents the e-mail's html body; use the e-mails html body for the real thing '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> First we isolate the TABLE block >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 'As you already do, we are banking on the given account number being included somewhere in the body of the html 'not only in the body, but within a TABLE object; if it's not, then we are SOL! 'get the pos of your account number which is in the middle of a table object nTableStart = InStr(1, strHTMLBody, strAccount) 'now get the pos of the start of the table object by going in reverse from the starting pos of the previous instr 'checking using uppercase because the source case is unknown nTableStart = InStrRev(UCase(strHTMLBody), "<TABLE") 'leaving out the ending > incase there are other things in the tag 'now get the end of the table object 'checking using uppercase because the source case is unknown nTableEnd = InStr(nTableStart, UCase(strHTMLBody), "</TABLE>") + Len("</TABLE>") 'save the original table in a string so you can replace it with the new table later strTableOrg = Mid(strHTMLBody, nTableStart, nTableEnd - nTableStart) MsgBox "This is our table isolated from the HTML." & vbCrLf & vbCrLf & "We are going to replace it with a modified version that only shows rows with the given account number" & vbCrLf & vbCrLf & strTableOrg '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< First we isolate the TABLE block <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> Now we modify the table block and replace the original HTML >>>>>>>>>>>>>>>>>>>>>>>> strTableNew = GetUpdatedTable(strTableOrg, strAccount) MsgBox "This is our modified table." & vbCrLf & vbCrLf & "Now all we have to do is replace the original table with this one in our HTML:" & vbCrLf & vbCrLf & strTableNew MsgBox "The Original HTML:" & vbCrLf & vbCrLf & strHTMLBody strHTMLBody = Replace(strHTMLBody, strTableOrg, strTableNew) MsgBox "This is the Modified HTML: " & vbCrLf & vbCrLf & strHTMLBody End Function
现在，将以下function粘贴到上一个function的结束function之后的新模块中。 这只是表格replacefunction，应该保持原样。 除非他们改变电子邮件中html的格式，否则它应该继续正常工作
Function GetUpdatedTable(ByRef strTableOrg As String, ByRef strAccount As String) As String 'now we have the table isolated and can play around until the desired results are acheived ' On Error GoTo ErrHandler Dim strTable As String Dim nStart As Long, nEnd As Long Dim strTRBlock As String 'first tr is just blank nStart = InStr(1, strTableOrg, "<tr") If nStart < 1 Then Exit Function 'couldnt find it nStart = nStart + Len("<tr") '2nd tr is 'Account Details' nStart = InStr(nStart, strTableOrg, "<tr") If nStart < 1 Then Exit Function 'couldnt find it nStart = nStart + Len("<tr") '3rd tr is the column headers nStart = InStr(nStart, strTableOrg, "<tr") If nStart < 1 Then Exit Function 'couldnt find it nEnd = InStr(nStart, strTableOrg, "</tr>") + Len("</tr>") 'we now have the first part of the table preserved strTable = Left(strTableOrg, nEnd - 1) 'ditching that preserved part from what we do next.; all trs should have class="xsmall") strTableOrg = Trim(Replace(strTableOrg, strTable, "")) nStart = 1 Do nStart = InStr(nStart, strTableOrg, "<tr") If nStart < 1 Then Exit Do nEnd = InStr(nStart, strTableOrg, "</tr>") + Len("</tr>") strTRBlock = Trim(Mid(strTableOrg, nStart, nEnd - nStart)) 'see if the account number is in this tr block If InStr(1, strTRBlock, strAccount) > 0 Then strTable = strTable & strTRBlock 'it was found so add this to the resulting table; we dont care about the block if it wasnt found End If nStart = nEnd Loop 'add the </table> part since it wasnt accounted for strTable = strTable & "</table>" GetUpdatedTable = strTable ErrHandler: If Err.Number <> 0 Then MsgBox Err.Description, vbExclamation, "Error " & Err.Number End If End Function
最后，单击TestHtmlTableReplace（）函数体内的某处并运行代码。 快乐的编码和一个非常愉快的第四！