VBA系列-021.按指定条件批量删除工作簿

021.按指定条件批量删除工作簿

第一步

Sub GetFiles()
    Dim strPath As String, strFileName As String, k As Long
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then strPath = .SelectedItems(1) Else: Exit Sub
        '获取用户选择的文件夹的路径,如果未选取,则退出程序
    End With
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    Application.ScreenUpdating = False
    Range("a:b").Clear: k = 1
    '清除A:B列的所有
    Cells(1, 1) = "旧文件名": Cells(1, 2) = "是否删除"
    strFileName = Dir(strPath & "*.xls*")
    Do While strFileName <> ""
        k = k + 1
        Cells(k, 1) = strPath & strFileName
        strFileName = Dir
    Loop
    Application.DisplayAlerts = True
End Sub

第二步

Sub DeleteFile()
    Dim r, i As Long
    r = Range("a1").CurrentRegion '数据装入数组
    For i = 2 To UBound(r)
    '标题行不要,从数组第二行开始遍历
        If r(i, 2) = "删除" Then Kill r(i, 1) 'Kill语句删除指定文件
    Next
    MsgBox "完成。"
End Sub