打开Excel工作簿时忽略错误

我有一个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

你真的没有办法检查文件是否好。 您可能可以通过一些error handling来处理它。 请参阅两个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