提问人：emphyrio 提问时间：11/3/2023 最后编辑：marc_semphyrio 更新时间：11/4/2023 访问量：44
VBA Web浏览器查找文本 下一个实例
VBA webbrowser findtext next occurrences
问：
我使用 Web 浏览器控件作为 MS Access 2010 数据库中的 html 编辑器。我正在尝试创建一个查找文本函数来查找某些字符串，然后选择它们。
我正在使用这个代码，它工作正常：
Private WithEvents oWeb As WebBrowser
Public Function FindAndHighlight(strText As String)
Dim tr As IHTMLTxtRange
Set oWeb = Me.webbrowser0.Object
Set tr = oWeb.document.body.createTextRange
tr.findText strText
tr.Select
tr.scrollIntoView
End Function
但这只会找到搜索字符串的第一个匹配项。在我找到第一个出现项之后，我该如何找到下一个，然后找到下一个，依此类推......？
希望有人能让我走上正轨......
BR， Emphyrio
答：
0赞
emphyrio
11/4/2023
#1
最终，我自己找到了答案。回想起来，解决方案实际上很简单。一旦我意识到找到的关键字的选择也是一个文本范围，事情就水到渠成。这是我的解决方案：
Private Function findAndHighlight(strText As String) As Boolean
Dim tr As IHTMLTxtRange, result As Long, MBtxt As String
If oWeb Is Nothing Then Set oWeb = Me.w1.Object
repeatSearch:
'create a text range from the selection
Set tr = oWeb.document.Selection.createRange
'if there is no selection, set the text range to the complete document
'if there is a selection:
'1. move the end point of the selection to the end of the document
'2. move the start point of the selection one character up (to prevent the finding the same word )
If Len(tr.Text) = 0 Then
Set tr = oWeb.document.body.createTextRange
Else
tr.setEndPoint "EndToEnd", tr
tr.moveStart "character", 1
End If
'try to find the keyword in the text range
result = tr.findText(strText)
'if succesful: select the keyword and scroll into view
'if not succesful: clear the selection and prompt the user to start searching from the beginning
If result Then
tr.Select
tr.scrollIntoView
Else
oWeb.document.Selection.empty
MBtxt = "Your search string was not found, do want to search from the beginning of the document?"
If MsgBox(MBtxt, vbYesNo, "keyword not found") = vbYes Then GoTo repeatSearch
End If
End Function
评论
oWeb.Document.body.createTextRange对我不起作用。 应该移动选择的开头，但我认为如果不将选择包裹在元素中，您将无法将选择滚动到视图中。您可能需要考虑使用 JavaScript 或 JQuery 库来完成这项工作，并使用来调用函数。参见 MarkJStr.moveStartoWeb.Document.parentWindow.execScript