Reputation: 33
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
Upvotes: 2
Views: 812
Reputation: 149325
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
Upvotes: 3