2016-01-25 5 views
1

У меня есть код VBA Excel, этот код будет объединять все файлы Excel, расположенные в одной папке. мне нужно, что код, чтобы игнорировать любые файлы, которые не открываются по той или иной причине, как, файл поврежден или не совместимы или ....Игнорировать ошибку при открытии книги 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 
+0

Попробуйте добавить в начале 'Application.DisplayAlerts = false' и' Application.DisplayAlerts = true' в конце – MatthewD

ответ

0

Вы надеваете» У меня действительно есть способ проверить, хорош ли файл. Возможно, вам удастся обработать его с некоторой обработкой ошибок. См. Два заявления 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 
+0

На самом деле этот метод не работает, я имею в виду что-то подобное «если заявление» , если файл можно открыть и прочитать из excel, вперед, другой мудрый следующий файл в нем. –

+0

@Hatem Husam Я изменил ответ на другой подход. – MatthewD

Смежные вопросы