用VBA逐个打开文件夹中的文档，查找是否存在对应字符

最新推荐文章于 2024-09-29 15:36:55 发布

zhangdabai1

最新推荐文章于 2024-09-29 15:36:55 发布

阅读量664

点赞数 12

文章标签： word

本文链接：https://blog.csdn.net/zhangdabai1/article/details/136146924

版权

一、效果展示

1、文件夹有如下的40个文件

2、找到目标内容的文件时，会弹窗提示

二、代码

Sub 批量打开文件进行查找目标内容()
    Dim FSO As Object, 文件夹 As Object
    
    '建立数组储存找到的文件名
    Dim 文件名() As String, 目标文件夹 As String, 目标内容 As String, f, i, b, t, j As Integer
    Dim Mydoc As Document, 文件
    
    目标内容 = "哈哈哈哈"
    目标文件夹 = "H:\用户\桌面\A"
    t = Timer
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set 文件夹 = FSO.GetFolder(目标文件夹)
    For Each f In 文件夹.Files
        If Right(f, 3) = "doc" Or Right(f, 4) = "docx" Then
            ReDim Preserve 文件名(j)
            文件名(j) = f
            Debug.Print "文件名" & j & "：" & 文件名(j)
            j = j + 1
        Else: End If
    Next
    '打开文档
    j = 0
    For Each 文件 In 文件名
        Set Mydoc = Documents.Open(FileName:=文件, ReadOnly:=False)
        '对文档进行操作
        If 查找(目标内容, False, True) Then
            '判断用户是否想继续
            b = 是否退三选项("已找到目标内容：" & 目标内容 & vbCr _
                & "文件地址：" & 文件 & vbCr _
                & "共用时" & Timer - t & "秒，是否继续查找其他文档")
            If b = 1 Or b = 2 Then
                Exit For
            End If
        End If
        j = j + 1
        Mydoc.Close
    Next
    Set Mydoc = Nothing
    If b = 0 Then
        MsgBox "未找到！"
    End If
End Sub

Function 是否退三选项(窗口信息 As String)
    Dim result As String
    ' 显示提示信息并弹出对话框
    result = MsgBox(窗口信息, vbYesNoCancel + vbInformation, "选择操作")
    ' 判断用户选择的按钮
    Select Case result
        Case vbYes ' 选择了选项“是”
            是否退三选项 = 0
        Case vbNo ' 选择了选项“否”
            是否退三选项 = 1
        Case vbCancel ' 取消操作
            是否退三选项 = 2
    End Select
End Function

Function 查找(文本, 通配符, 向下)
    With Selection.Find
        .ClearFormatting
        .text = 文本
        .Forward = 向下
        .Wrap = wdFindContinue '往复查找
        .MatchWildcards = 通配符
        .Execute
        .Parent.Select
        查找 = .Found
    End With
End Function