一、效果示例
如查“预算”，
可以查到含有“预算”的所有文档
二、代码
Sub 从word或PDF查文本()
Dim na$, i!, arr(1 To 100), arr1(1 To 100), arr2(1 To 100)
i = 0
k = 0
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "请选择所在文档的底层文件夹"
If fd.Show = -1 Then
MyPath = fd.SelectedItems(1)
sh = InputBox("输入要查的字符")
If sh = "" Then Exit Sub
na = Dir(MyPath & "\" & "*.*")
Set wapp = CreateObject("word.application") '新建word对象
Do While na <> ""
k = k + 1
Set wdoc = wapp.Documents.Open(Filename:=MyPath & "\" & na, ReadOnly:=True)
Set myrange = wapp.ActiveDocument.Range
With myrange.Find
.ClearFormatting '清除查格式
.Text = sh
Do While .Execute
i = i + 1
arr(i) = na
arr1(i) = "在第" & myrange.Information(3) & "页" '需用常量3代表页码
arr2(i) = myrange.Sentences.Item(1) '读取所在句子
Loop
End With
wdoc.Close wdDoNotSaveChanges
na = Dir
Loop
Set wapp = Nothing
Set wdoc = Nothing
If i > 0 Then
ActiveCell.Value = "文档名称"
ActiveCell.Offset(0, 1).Value = "所在页数"
ActiveCell.Offset(0, 2).Value = "所在句子"
ActiveCell.Offset(1, 0).Resize(i, 1) = WorksheetFunction.Transpose(arr)
resize函数vbaActiveCell.Offset(1, 1).Resize(i, 1) = WorksheetFunction.Transpose(arr1)
ActiveCell.Offset(1, 2).Resize(i, 1) = WorksheetFunction.Transpose(arr2)
For j = 1 To i
ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(j, 0), Address:=MyPath & "\" & ActiveCell.Offset(j, 0).Value, _
TextToDisplay:=ActiveCell.Offset(j, 0).Value
Next
End If
MsgBox "完成查" & k & "个文档；" & i & "个句子符合条件。"
End If
End Sub

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。