Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
loop does not work correctly
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
loop does not work correctly
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
loop does not work correctly
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
SMALL function seems not to work correctly | Excel Worksheet Functions | |||
Sorting numbers doesn't work correctly | New Users to Excel | |||
How do I get Auto-Fit to work correctly? | Excel Worksheet Functions | |||
custom filter does not work correctly | Excel Discussion (Misc queries) | |||
RunAutoMacros does not work correctly from vbscript! | Excel Programming |