2
votes

I have a macro that I used for importing data from many excel workbooks in a directory. It worked just fine in Excel 2003 but since I've recently been upgraded to Excel 2010 the macro doesn't seem to work. When activated the macro doesnt error out or produce anything. I've changed all the Trust Center Settings and other macros I have (not importing data macros) work just fine. I am not very skilled at writing VBA and cannot see where an issue may lie. It just seems like excel trys to run the macro and skips everything it once did and finishes. Any help is greatly appreciated. Thank you

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
1

1 Answers

3
votes

On Error Resume Next should be really avoided unless needed. It's like telling Excel to Shut Up. The main problem is that Application.FileSearch is not supported in xl2007+

You can use Application.GetOpenFilename instead.

See this example. (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