Импорт макроса Excel 2003 не работает в Excel 2010

Question

У меня есть макрос, который я использовал для импорта данных из многих Excel-книг в каталог. Он отлично работал в Excel 2003, но поскольку я недавно был обновлен до Excel 2010, макрос не работает. При активации макрос не выдает ошибку или не производит ничего. Я изменил все настройки центра доверия и другие макросы, которые у меня (не импортирующие макросы данных) работают очень хорошо. Я не очень разбираюсь в написании VBA и не вижу, где может быть проблема. Просто кажется, что Excel пытается запустить макрос и пропускает все, что он когда-то делал и заканчивал. Любая помощь приветствуется. Спасибо

Sub GDCHDUMP() 
Dim lCount As Long 
Dim wbResults As Workbook 
Dim twbk As Workbook 


Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
Application.EnableEvents = False 

On Error Resume Next 
Set twbk = ThisWorkbook 
    With Application.FileSearch 
    .NewSearch 
    'Change path to suit 
    .LookIn = "R:\ServCoord\GCM\Data Operations\Quality\GDCHDump" 
    .filename = "*.xls*" 
    If .Execute > 0 Then 'Workbooks in folder 
     For lCount = 1 To .FoundFiles.Count 'Loop through all 
     'Open Workbook x and Set a Workbook variable to it 
     Set wbResults = Workbooks.Open(filename:=.FoundFiles(lCount), UpdateLinks:=0) 
     Set ws = wbResults.Sheets(1) 
     ws.Range("B2").Copy 
     twbk.Sheets(1).Cells(lCount, 1).PasteSpecial xlPasteValues 
     wbResults.Close SaveChanges:=False 
     'There was a lot more lines like the 2 above that I removed for clarity 
     Next lCount 
    End If 
End With 
On Error GoTo 0 
Application.ScreenUpdating = True 
Application.DisplayAlerts = True 
Application.EnableEvents = True 
End Sub 

Answer 1

On Error Resume Next следует действительно избегать, если не требуется. Это как сказать Excel Shut Up. Основная проблема заключается в том, что Application.FileSearch не supported в xl2007 +

Вы можете использовать Application.GetOpenFilename вместо этого.

См. Этот пример. (UNTESTED)

Option Explicit 

Sub GDCHDUMP() 
    Dim lCount As Long 
    Dim wbResults As Workbook, twbk As Workbook 
    Dim ws As Worksheet 
    Dim strPath As String 
    Dim Ret 
    Dim i As Long 

    strPath = "R:\ServCoord\GCM\Data Operations\Quality\GDCHDump" 

    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
    Application.EnableEvents = False 

    Set twbk = ThisWorkbook 

    ChDir strPath 
    Ret = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , , , True) 

    If TypeName(Ret) = "Boolean" Then Exit Sub 

    For i = LBound(Ret) To UBound(Ret) 
     Set wbResults = Workbooks.Open(Filename:=Ret(i), UpdateLinks:=0) 
     Set ws = wbResults.Sheets(1) 
     ws.Range("B2").Copy 
     'twbk.Sheets(1).Cells(lCount, 1).PasteSpecial xlPasteValues 
     wbResults.Close SaveChanges:=False 
    Next i 

    Application.ScreenUpdating = True 
    Application.DisplayAlerts = True 
    Application.EnableEvents = True 
End Sub