如果包含VBA的各种短语，如何删除ms-word文档？

Question

I am very new to VBA and I am aware this contains errors.

In MS-Word developer, I would like to go up one directory, search all *.docx files for multiple strings, if any of the strings exist within the *docx file, I would like to delete the file.

Sub loopFiles()

Dim fso As New FileSystemObject
Dim fil As File
Dim fold As Folder
Dim yourfolder As String
Dim UpOneDir As String

Set fold = fso.GetFolder(Application.ActiveWorkbook.Path)

For Each fil In fold.Files

UpOneDir = Left(fil.Path, Len(fil.Path) - Len(fil.Name) - 1 - Len(Split(Left(fil.Path, Len(fil.Path) - Len(fil.Name) - 1), "\")(UBound(Split(Left(fil.Path, Len(fil.Path) - Len(fil.Name) - 1), "\")))))

Sub FindIt()
        Selection.HomeKey Unit:=wdStory
        With Selection.Find
            .ClearFormatting
            .Text = "Aircraft Survey","Cc:","UTAS","Inserted in the word document is a pdf file"
            .Forward = True
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = True
            Do While .Execute

            If InStr(1, fil.Text, "Aircraft Survey","Cc:","UTAS","Inserted in the word document is a pdf file") > 0 Then
                Application.Workbook.Open fil.Path
                ActiveWorkbook.Close

            fil.Delete True
        End If
    Loop
End With
End Sub
End Sub

Answer 1

Here's how I would do it. You might want to test this by commenting out the oFile.Delete and replace it with a MsgBox oFile.Name so it doesn't just delete files. Once you're happy that it's definitely finding the files you require, use the delete command.

Option Explicit


Sub loopFiles()
    Dim oFso: Set oFso = CreateObject("Scripting.FileSystemObject") ' create FileSystemObject
    Dim oFolder: Set oFolder = oFso.GetFolder(oFso.GetParentFolderName(ThisDocument.Path))    ' Set folder to the Parent of the folder containing this file
    Dim oFile, oDocument, textVal, bFound
    Dim TextValues: TextValues = Array("Aircraft Survey", "Cc:", "UTAS", "Inserted in the word document is a pdf file") ' create array of terms to check

    For Each oFile In oFolder.Files
        If Right(oFile.Name, 5) = ".docx" Then  ' if file is a *.docx
            Set oDocument = Documents.Open(oFile.Path)  ' Open it
            bFound = False                              ' Initialise
            For Each textVal In TextValues  ' check for each text value
                With oDocument.Content.Find
                    .Text = textVal
                    .Forward = True
                    .Execute
                    If .Found = True Then       ' if found then set bFound
                        bFound = True
                        Exit For                ' and exit the loop, no need to keep looking
                    End If
                End With
            Next
            oDocument.Close wdDoNotSaveChanges  ' close file and don't save any changes
            If bFound = True Then               ' If the text was found in the file
                oFile.Delete                    ' delete the file
            End If
        End If
    Next

End Sub