2016-01-25 83 views
1

我有一个Excel VBA代码,该代码将合并位于一个文件夹中的所有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

其实这种方法是行不通的,我在考虑类似“if语句” ,如果文件可以打开并从excel中读取,那么直接下一个文件即可。 –

+0

@Hatem Husam我将答案改为另一种方法。 – MatthewD