Question

我有一个Excel VBA代码，该代码将合并位于一个文件夹中的所有Excel文件。我需要该代码忽略因某种原因而无法打开的文件，例如文件已损坏或不兼容或....

代码是：

Sub simpleXlsMerger()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")

'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("C:\Users\user\Desktop\Stock- Pharmacies - Copy\Airport STK 15-12-2015\New folder")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)

'change "A2" with cell reference of start point for every files here
'for example "B3:IV" to merge all files start from columns B and rows 3
'If you're files using more than IV column, change it to the latest column
'Also change "A" column on "A65536" to the same column as start point
Range("A1:IV" & Range("A65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate

'Do not change the following column. It's not the same column as above
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close
Next
End Sub

Answer 1

你真的没办法检查文件是否合适。您可以通过一些错误处理来处理它。请参阅两个On Error Goto语句和NextIteration:标签。试一试。

Sub simpleXlsMerger()

    Dim bookList As Workbook
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
    Application.ScreenUpdating = False
    Set mergeObj = CreateObject("Scripting.FileSystemObject")

    'change folder path of excel files here
    Set dirObj = mergeObj.Getfolder("C:\Users\user\Desktop\Stock- Pharmacies - Copy\Airport STK 15-12-2015\New folder")
    Set filesObj = dirObj.Files
    For Each everyObj In filesObj

        On Error Goto NextIteration
        Set bookList = Workbooks.Open(everyObj)
        On Error Goto 0

        'change "A2" with cell reference of start point for every files here
        'for example "B3:IV" to merge all files start from columns B and rows 3
        'If you're files using more than IV column, change it to the latest column
        'Also change "A" column on "A65536" to the same column as start point
        Range("A1:IV" & Range("A65536").End(xlUp).Row).Copy
        ThisWorkbook.Worksheets(1).Activate

        'Do not change the following column. It's not the same column as above
        Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
        Application.CutCopyMode = False
        bookList.Close

NextIteration: 'This is your goto label

    Next

End Sub

打开Excel工作簿时忽略错误

1 个答案: