删除电子邮件中某个字符串前后的文本（最多一个单词）
我希望创建一个VBA宏（来自Excel），用于搜索正文中包含帐号的电子邮件，并删除该电子邮件中的所有其他表元素，但具有我指定的元素的行除外。
例如，请参阅下面的附件。让我们说我搜索的号码是＆＃34; 222222222222＆＃34;数。我需要VBA代码来保留表头，删除所有不是＆＃34; 22222222222＆＃34; （所以所有1111账户）同时保持持有数量。是否有代码可以删除＆＃34; 2222222222＆＃34;之后的所有文字。但请停止删除＆＃34; Term＆＃34;？在那个令牌上，它可以在单词＆＃34;截止日期＆＃34;之后开始删除。但是当它到达＆＃34; 222222时停止删除...＆＃34;帐户？
如果有任何我可以专注的方法来实现这一点，请告诉我。
谢谢！
（PS这些电子邮件的长度各不相同，其中很多都是每天收到的。此外，我已经有了可以通过搜索文本来搜索和打开电子邮件的代码。我只是无法弄清楚如何删除我不想要的这些无关紧要的东西。）
我已附上我的相关代码以搜索并打开以下电子邮件：
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
代码可能看起来令人困惑，但它只是在特定的outlook文件夹中搜索包含特定值的邮件（在单元格A1中...在这种情况下... 222222222222），然后打开电子邮件，转发电子邮件，并突出显示电子邮件中的帐号（2222222222）。
理想情况下，一段代码可以在＆＃34; 22222222＆＃34;之前删除所有文字。帐号直到＆＃34;截止日期＆＃34;除了可以在＆＃34; 2222222＆＃34;之后删除文本的代码。数字，直到它命中＆＃34; Term＆＃34;。问题是我还需要保留数量，因为这个数字确实可以是任何事情，我很难想到如何做到这一点。 任何指导将不胜感激！
- 编辑 -
以下是＆＃34;表＆＃34;的代码。即使它实际上没有显示表标签。这是帐号出现的地方。我将它们改为＆＃34; 111111＆＃34;和＆＃34; 222222＆＃34;分别。
</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>
1 个答案:
答案 0 :(得分：2)
这真是太糟糕了，但并不令人惊讶，因为这里有很多事情发生。让我们尝试不同的方法。这是一个不涉及Excel或Outlook的示例。我这样做是为了清楚，因为Excel和Outlook的东西正在弄清楚工作。我将让您决定如何将其插入现有功能。
请删除我以前的任何代码并在Excel中创建一个新模块。 （假设您从代码的外观中使用Excel）
将以下函数粘贴到新模块中; 它只返回一个模拟Outlook邮件项的html正文的字符串。该表的格式与您提供的格式相同。
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
现在，请在上一个功能的结束功能之后将以下内容粘贴到新模块中。 这包含将进入您的主要功能的变量和功能，但您需要＆＃39 ;为了满足您的需求，我需要玩它。评论和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
现在，将以下函数粘贴到上一个函数的End Function之后的新模块中。 这只是应该保持不变的表替换函数。它应该继续在它自己的工作正常，除非他们＆＃39;他们＆＃39;更改电子邮件中的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（）函数体内的某处并运行代码。快乐的编码和非常快乐的第4名！
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？