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
wrote in message
ups.com...
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.
Dave Peterson wrote:
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
wrote:
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