Excel 2003에서 Excel 2003 가져 오기 매크로가 작동하지 않습니다.

Question

디렉터리의 많은 Excel 통합 문서에서 가져온 데이터를 가져 오는 매크로가 있습니다. Excel 2003에서는 제대로 작동했지만 최근에 Excel 2010으로 업그레이드 한 이후 매크로가 작동하지 않는 것 같습니다. 매크로를 활성화하면 오류가 발생하지 않거나 아무 것도 생성되지 않습니다. 모든 보안 센터 설정 및 다른 매크로 (데이터 매크로 가져 오기가 아닌)를 올바르게 변경했습니다. VBA를 쓰는 데 익숙하지 않아 문제가 어디에 있는지 알 수 없습니다. 그것은 단지 매크로를 실행하려고 시도한 것처럼 보이고 한 번 완료하고 완료 한 모든 것을 건너 뜁니다. 어떤 도움이라도 대단히 감사합니다. 고맙습니다.

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이 xl2007 +

에 supported이 아니기 때문입니다.

대신 Application.GetOpenFilename을 사용할 수 있습니다.

이 예제를 참조하십시오. D : (안된)

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