按文件名中的关键字分检到指定文件夹

limonet

换个方法，减少循环。

limonet

Sub limonet()
    Dim Arr As Variant, WSHShell As Object, StrCommand$, StrOutPut$, i%
    Set WSHShell = CreateObject("WScript.Shell")
    WSHShell.currentdirectory = ThisWorkbook.Path
    StrCommand = "Powershell Get-ChildItem  -Directory | ? { -not (Get-ChildItem $_.FullName -Recurse -File -Filter '*附件2*.xlsx')} | Select Name"
    Set WshShellExec = WSHShell.Exec(StrCommand)
    StrOutPut = WshShellExec.StdOut.ReadAll
    Arr = Split(StrOutPut, Chr(10))
    For i = 3 To UBound(Arr) - 3
        Cells(i - 1, "A") = Arr(i) & "文件夹中没有附件2"
    Next i
    MkDir ThisWorkbook.Path & "\附件2汇总"
    WSHShell.Run "Powershell get-childitem " & ThisWorkbook.Path & " -file *附件2* -recurse | move-item -destination " & ThisWorkbook.Path & "\附件2汇总", 0, True
End Sub