如何将VBA宏应用于文件夹中的所有Excel文件?

时间:2019-10-30 00:12:33

标签: excel vba

我想删除多个Excel工作簿上的工作表。我已经有一些VBA代码可以在单个文件中删除工作表:

Sub delete_sheet()
Application.DisplayAlerts = False
For Each aSheet In Worksheets
    Select Case aSheet.Name
        Case "INV."
            aSheet.Delete
    End Select

    Next aSheet
    Application.DisplayAlerts = True
End Sub

我的文件夹中有500个文件,这些文件都需要删除一个名为“ INV”的选项卡。如何将此操作应用于文件夹中的所有文件?我已经尝试过以下网站提供的示例:https://analystcave.com/vba-run-macro-on-all-files-in-a-folder-all-worksheets-in-a-workbook/

Sub RunOnAllFilesInFolder()
    Dim folderName As String, eApp As Excel.Application, fileName As String
    Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook
    Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    Set currWb = ActiveWorkbook: Set currWs = ActiveSheet

    'Select folder in which all files are stored
    fDialog.Title = "Select a folder"
    fDialog.InitialFileName = currWb.Path
    If fDialog.Show = -1 Then
      folderName = fDialog.SelectedItems(1)
    End If


    'Create a separate Excel process that is invisibile
    Set eApp = New Excel.Application:  eApp.Visible = False

    'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]
    fileName = Dir(folderName & "\*.*")
    Do While fileName <> ""
        'Update status bar to indicate progress
        Application.StatusBar = "Processing " & folderName & "\" & fileName

        Set wb = eApp.Workbooks.Open(folderName & "\" & fileName)

'I tried placing my code here
Sub delete_sheet()
Application.DisplayAlerts = False
For Each aSheet In Worksheets
    Select Case aSheet.Name
        Case "INV."
            aSheet.Delete
    End Select

    Next aSheet
    Application.DisplayAlerts = True
End Sub

        wb.Close SaveChanges:=True 'Close opened worbook w/o saving, change as needed
        Debug.Print "Processed " & folderName & "\" & fileName 
        fileName = Dir()
    Loop
    eApp.Quit
    Set eApp = Nothing
    'Clear statusbar and notify of macro completion
    Application.StatusBar = ""
    MsgBox "Completed executing macro on all workbooks"
End Sub

当我尝试执行它时,它使我的excel崩溃了。有什么建议吗?

1 个答案:

答案 0 :(得分:1)

您可以执行以下操作:

'...
fileName = Dir(folderName & "\*.*")
Do While fileName <> ""
    'Update status bar to indicate progress
    Application.StatusBar = "Processing " & folderName & "\" & fileName

    Set wb = Workbooks.Open(folderName & "\" & fileName)
    Application.DisplayAlerts = False
    On Error Resume Next
    wb.Worksheets("INV.").Delete
    On Error Goto 0
    Application.DisplayAlerts = True
    wb.Close True 'save changes

    fileName = Dir()
Loop

...或者如果您想保留原始的单独子项:

Sub RunOnAllFilesInFolder
 '...
fileName = Dir(folderName & "\*.*")
Do While fileName <> ""
    'Update status bar to indicate progress
    Application.StatusBar = "Processing " & folderName & "\" & fileName

    Set wb = Workbooks.Open(folderName & "\" & fileName)

    delete_sheet wb, "INV."  '<< call your Sub and pass the workbook & sheet name

    wb.Close True 'save changes

    fileName = Dir()
Loop
'...
End Sub


Sub delete_sheet(wb As Workbook, shtName as String)
    Dim aSheet As Worksheet
    For Each aSheet In wb.Worksheets
        If aSheet.Name = shtName Then
            Application.DisplayAlerts = False
            aSheet.Delete
            Application.DisplayAlerts = True
            Exit For 'done looking...
        End If
    Next aSheet
End Sub