删除电子邮件中某个字符串前后的文本（最多某个单词）
Delete text before and after a certain string in email (up to a certain word)
我想创建一个 VBA 宏（来自 Excel），用于在 body 中搜索带有帐号的电子邮件，并删除所有其他 table 该电子邮件中的元素，但包含我指定的元素的行除外。
例如，请看下面的附件。假设我搜索的号码是“222222222222”号码。我需要 VBA 代码来保留 table headers，删除所有不是“22222222222”的账户（所以所有 1111 个账户）同时保持持有数量.是否有代码可以删除“2222222222”之后的所有文本，但停止删除单词"Term"？在那个标记上，它是否可以在单词 "Deadline" 之后开始删除，但在到达“222222...”帐户时停止删除？
请告诉我是否有任何我可以专注于实现此目标的方法。
谢谢！
(P.S。这些邮件长短不一，每天都会收到很多。另外，我已经有了可以通过搜索文本来搜索和打开邮件的代码。我就可以'我不知道如何删除这些我不想要的无关内容。）
我已附上我的相关代码以搜索并打开下面的电子邮件：
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)。
理想情况下，一段代码可以删除“22222222”帐号之前的所有文本，直到单词 "Deadline"，此外还有一段代码可以删除“2222222”号码之后的文本，直到它命中单词 "Term"。问题是我还需要保留数量，因为这个数字真的可以是任何东西，所以我很难想到如何做到这一点。
任何指导将不胜感激！
-- 编辑--
这里是 "table" 的代码，尽管它实际上并不显示 table 标签。这是帐号出现的地方。我分别将它们更改为“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 的东西正在破坏工作。我会让您决定如何将其插入现有功能。
请删除我以前的任何代码并在 Excel 中创建一个新模块。 （假设从代码的外观来看您正在使用 Excel）
将以下函数粘贴到您的新模块中； 它只是 returns 模拟 outlook 的 html 正文的字符串邮件项目。 table 与您提供的格式相同。
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
现在，请在上一个函数的结束函数之后将以下内容粘贴到新模块中。 这包含将进入您的函数的变量和功能主要功能，但您需要使用它才能满足您的需求。评论和 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 之后。 这只是 table 替换函数应该保持原样。除非 'they' 更改电子邮件
中 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 岁！
我想创建一个 VBA 宏（来自 Excel），用于在 body 中搜索带有帐号的电子邮件，并删除所有其他 table 该电子邮件中的元素，但包含我指定的元素的行除外。
例如，请看下面的附件。假设我搜索的号码是“222222222222”号码。我需要 VBA 代码来保留 table headers，删除所有不是“22222222222”的账户（所以所有 1111 个账户）同时保持持有数量.是否有代码可以删除“2222222222”之后的所有文本，但停止删除单词"Term"？在那个标记上，它是否可以在单词 "Deadline" 之后开始删除，但在到达“222222...”帐户时停止删除？
请告诉我是否有任何我可以专注于实现此目标的方法。
谢谢！
(P.S。这些邮件长短不一，每天都会收到很多。另外，我已经有了可以通过搜索文本来搜索和打开邮件的代码。我就可以'我不知道如何删除这些我不想要的无关内容。）
我已附上我的相关代码以搜索并打开下面的电子邮件：
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)。
理想情况下，一段代码可以删除“22222222”帐号之前的所有文本，直到单词 "Deadline"，此外还有一段代码可以删除“2222222”号码之后的文本，直到它命中单词 "Term"。问题是我还需要保留数量，因为这个数字真的可以是任何东西，所以我很难想到如何做到这一点。 任何指导将不胜感激！
-- 编辑--
这里是 "table" 的代码，尽管它实际上并不显示 table 标签。这是帐号出现的地方。我分别将它们更改为“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 的东西正在破坏工作。我会让您决定如何将其插入现有功能。
请删除我以前的任何代码并在 Excel 中创建一个新模块。 （假设从代码的外观来看您正在使用 Excel）
将以下函数粘贴到您的新模块中； 它只是 returns 模拟 outlook 的 html 正文的字符串邮件项目。 table 与您提供的格式相同。
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
现在，请在上一个函数的结束函数之后将以下内容粘贴到新模块中。 这包含将进入您的函数的变量和功能主要功能，但您需要使用它才能满足您的需求。评论和 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 之后。 这只是 table 替换函数应该保持原样。除非 'they' 更改电子邮件
中 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 岁！