Excel 2003导入宏在Excel 2010中不起作用

Question

我有一个宏，用于从目录中的许多Excel工作簿导入数据。它在Excel 2003中工作得很好，但是由于我最近升级到Excel 2010，宏似乎不起作用。当被激活时，宏不会出错或产生任何东西。我已经更改了所有信任中心设置和我拥有的其他宏（不导入数据宏）。我不擅长编写VBA，也不知道问题可能出在哪里。它只是看起来像excel trys运行宏并跳过它曾经做过和完成的一切。任何帮助是极大的赞赏。谢谢

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