loop does not work correctly

[fredagamie]

please help. I have put together a macro that will open up a folder
with my spreadsheets. The spreadsheets have a built in macro that will
copy the information i need. The next step is to place them into my
summary sheet which is where I run the original macro. The problem is
there are 4 spreadsheets in the folder, but for some reason it is only
pasting the information from workbooks 1 and 3 somehow ignoring 2 and
4. I think it is something in the loop, but can't figure out what.

any help is much appreciated.

Sub UPDATESUMMARY()

Dim i As Integer
Dim wbResults As Workbook
Dim wbCodeBook As Workbook

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

On Error Resume Next

Set wbCodeBook = ThisWorkbook

With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "C:\Tranportation"
.FileType = msoFileTypeExcelWorkbooks

If .Execute > 0 Then 'Workbooks in folder
For i = 1 To .FoundFiles.Count 'Loop through all.
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(.FoundFiles(i))
wbResults.RunAutoMacros xlAutoOpen
Windows("PayItem.xls").Activate
Sheets("Summary").Select
Range("A65535").End(xlUp).Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

wbResults.Close SaveChanges:=True


Next i


End If
End With

On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

 

[Dave Peterson]

There have be a lot of posts describing the troubles with .filesearch--trouble
arise with some versions of excel/windows.

If you're positive that there are 4 excel files in that folder, maybe using the
old Dir() to retrieve the filenames would be better.

Option Explicit
Sub testme01()

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim wkbk As Workbook

'change to point at the folder to check
myPath = "C:\Tranportation"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = ""
On Error Resume Next
myFile = Dir(myPath & "*.xls")
On Error GoTo 0
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

Application.ScreenUpdating = False

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then
For fCtr = LBound(myNames) To UBound(myNames)

Application.StatusBar _
= "Processing: " & myNames(fCtr) & " at: " & Now

Set wkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

'your code to do all the work here

wkbk.Close savechanges:=False
Next fCtr
End If

With Application
.ScreenUpdating = True
.StatusBar = False
End With

End Sub

 

[fredagamie]

Thanks for the quick response. Unfortunately I am getting the same
results. It gives me the data from the 1st and 3rd files. All these
files are copies of themselves just renumbered to get the macro to work
before putting it to use. I also found if I added the line
Workbooks(i).RunAutoMacros xlAutoOpen 'to my original code' I get file
2. very strange.

 

[Gary Keramidas]

i've used something like this:

Sub test()
Dim FileDir As Variant
Dim FName As Variant
Dim FilesInPath As String
Dim NumberOfFiles As Long
Dim MyFiles() As String

FileDir = Environ("USERPROFILE") & "\Desktop\Catalogs\"

FilesInPath = Dir(FileDir & "*.xls")

NumberOfFiles = 0
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

Do While FilesInPath <> ""

'open routine here
Workbooks.Open Filename:=FileDir & FilesInPath, ReadOnly:=True, UpdateLinks:=3

'do your routine



' close the workbook
Workbooks(FilesInPath).Close SaveChanges:=False

NumberOfFiles = NumberOfFiles + 1

ReDim Preserve MyFiles(1 To NumberOfFiles)
MyFiles(NumberOfFiles) = FilesInPath
FilesInPath = Dir()
Loop

End Sub


--


Gary

Thanks for the quick response. Unfortunately I am getting the same
results. It gives me the data from the 1st and 3rd files. All these
files are copies of themselves just renumbered to get the macro to work
before putting it to use. I also found if I added the line
Workbooks(i).RunAutoMacros xlAutoOpen 'to my original code' I get file
2. very strange.