| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Open all files, ignore some
Hi. The below code opens all files within a given folder, and consolidates
them into 1 file, 1 sheet. In each of the files to be consolidated, I have a veryhidden sheet called Test. Is there a way to have the code open files within the folder and consolidate ONLY the files that contain the sheet Test? These files are templates that are being emailed in. I just want to make sure that the file I get back is my file, so the formats are exactly the same. Also, it would be great to write a log to a text file that detailed the names of the files that were not consolidated becasue they did not contain the sheet Test. Thanks in advance for any and all of your help Dim sFolder As String Dim wb As Workbook Dim i As Long Dim fname As String Application.ScreenUpdating = False Application.DisplayAlerts = False Sheets("Consol").Select With Application.FileSearch .NewSearch .LookIn = "\\server\folder1\folder2\" .SearchSubFolders = False .filename = "*.xls" .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then For i = 1 To .FoundFiles.Count Set wb = Workbooks.Open(filename:=.FoundFiles(i)) fname = Left(ActiveWorkbook.name, Len(ActiveWorkbook.name) - 4) wb.ActiveSheet.Range("G5:G" & _ wb.ActiveSheet.Range("D65536").End(xlUp).Row).Valu e = fname wb.ActiveSheet.Range("A5:G" & _ wb.ActiveSheet.Range("D65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets("Consol").Range("A" & _ ThisWorkbook.Worksheets("Consol").Range("D65536"). End(xlUp).Offset(1, 0).Row).PasteSpecial _ Paste:=xlPasteValues wb.Close savechanges:=False fname = Nothing Next i Else MsgBox "Folder " & sFolder & " contains no required files" End If End With Application.ScreenUpdating = True Application.DisplayAlerts = True |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Open all files, ignore some
Hi Steph
Normal you must open the file to check the sheet name but you can use this to check it also without opening the file. On Error Resume Next SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , xlR1C1)) If Err.Number < 0 Then 'other code http://www.rondebruin.nl/summary2.htm See how i use it here -- Regards Ron de Bruin http://www.rondebruin.nl "Steph" wrote in message ... Hi. The below code opens all files within a given folder, and consolidates them into 1 file, 1 sheet. In each of the files to be consolidated, I have a veryhidden sheet called Test. Is there a way to have the code open files within the folder and consolidate ONLY the files that contain the sheet Test? These files are templates that are being emailed in. I just want to make sure that the file I get back is my file, so the formats are exactly the same. Also, it would be great to write a log to a text file that detailed the names of the files that were not consolidated becasue they did not contain the sheet Test. Thanks in advance for any and all of your help Dim sFolder As String Dim wb As Workbook Dim i As Long Dim fname As String Application.ScreenUpdating = False Application.DisplayAlerts = False Sheets("Consol").Select With Application.FileSearch .NewSearch .LookIn = "\\server\folder1\folder2\" .SearchSubFolders = False .filename = "*.xls" .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then For i = 1 To .FoundFiles.Count Set wb = Workbooks.Open(filename:=.FoundFiles(i)) fname = Left(ActiveWorkbook.name, Len(ActiveWorkbook.name) - 4) wb.ActiveSheet.Range("G5:G" & _ wb.ActiveSheet.Range("D65536").End(xlUp).Row).Valu e = fname wb.ActiveSheet.Range("A5:G" & _ wb.ActiveSheet.Range("D65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets("Consol").Range("A" & _ ThisWorkbook.Worksheets("Consol").Range("D65536"). End(xlUp).Offset(1, 0).Row).PasteSpecial _ Paste:=xlPasteValues wb.Close savechanges:=False fname = Nothing Next i Else MsgBox "Folder " & sFolder & " contains no required files" End If End With Application.ScreenUpdating = True Application.DisplayAlerts = True |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Open all files, ignore some
Steph,
here is a revised version. I have included a function to test if a sheetexists. BTW, you had a line fname = Nothing which errors for me as fname ius a string, so I change it to fname = "" Dim sFolder As String Dim wb As Workbook Dim i As Long Dim fname As String Dim FileNumber As Long Application.ScreenUpdating = False Application.DisplayAlerts = False Sheets("Consol").Select FileNumber = FreeFile ' Get unused file ' number. Open "c:\Findlog" For Output As #FileNumber With Application.FileSearch .NewSearch .LookIn = "\\server\folder1\folder2\" .SearchSubFolders = False .Filename = "*.xls" .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then For i = 1 To .FoundFiles.Count Set wb = Workbooks.Open(Filename:=.FoundFiles(i)) If SheetExists("Test", wb) Then fname = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) wb.ActiveSheet.Range("G5:G" & _ wb.ActiveSheet.Range("D65536").End(xlUp).row).Valu e = fname wb.ActiveSheet.Range("A5:G" & _ wb.ActiveSheet.Range("D65536").End(xlUp).row).Copy ThisWorkbook.Worksheets("Consol").Range("A" & _ ThisWorkbook.Worksheets("Consol").Range("D65536"). End(xlUp).Offset(1, 0).row).PasteSpecial _ Paste:=xlPasteValues wb.Close savechanges:=False fname = "" Else Write #FileNumber, wb.FullName End If Next i Else MsgBox "Folder " & sFolder & " contains no required files" End If End With Close #FileNumber Application.ScreenUpdating = True Application.DisplayAlerts = True '----------------------------------------------------------------- Function SheetExists(Sh As String, _ Optional wb As Workbook) As Boolean '----------------------------------------------------------------- Dim oWs As Worksheet If wb Is Nothing Then Set wb = ActiveWorkbook On Error Resume Next SheetExists = CBool(Not wb.Worksheets(Sh) Is Nothing) On Error GoTo 0 End Function -- HTH RP (remove nothere from the email address if mailing direct) "Steph" wrote in message ... Hi. The below code opens all files within a given folder, and consolidates them into 1 file, 1 sheet. In each of the files to be consolidated, I have a veryhidden sheet called Test. Is there a way to have the code open files within the folder and consolidate ONLY the files that contain the sheet Test? These files are templates that are being emailed in. I just want to make sure that the file I get back is my file, so the formats are exactly the same. Also, it would be great to write a log to a text file that detailed the names of the files that were not consolidated becasue they did not contain the sheet Test. Thanks in advance for any and all of your help Dim sFolder As String Dim wb As Workbook Dim i As Long Dim fname As String Application.ScreenUpdating = False Application.DisplayAlerts = False Sheets("Consol").Select With Application.FileSearch .NewSearch .LookIn = "\\server\folder1\folder2\" .SearchSubFolders = False .filename = "*.xls" .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then For i = 1 To .FoundFiles.Count Set wb = Workbooks.Open(filename:=.FoundFiles(i)) fname = Left(ActiveWorkbook.name, Len(ActiveWorkbook.name) - 4) wb.ActiveSheet.Range("G5:G" & _ wb.ActiveSheet.Range("D65536").End(xlUp).Row).Valu e = fname wb.ActiveSheet.Range("A5:G" & _ wb.ActiveSheet.Range("D65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets("Consol").Range("A" & _ ThisWorkbook.Worksheets("Consol").Range("D65536"). End(xlUp).Offset(1, 0).Row).PasteSpecial _ Paste:=xlPasteValues wb.Close savechanges:=False fname = Nothing Next i Else MsgBox "Folder " & sFolder & " contains no required files" End If End With Application.ScreenUpdating = True Application.DisplayAlerts = True |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Open all files, ignore some
Thank you so much!
"Bob Phillips" wrote in message ... Steph, here is a revised version. I have included a function to test if a sheetexists. BTW, you had a line fname = Nothing which errors for me as fname ius a string, so I change it to fname = "" Dim sFolder As String Dim wb As Workbook Dim i As Long Dim fname As String Dim FileNumber As Long Application.ScreenUpdating = False Application.DisplayAlerts = False Sheets("Consol").Select FileNumber = FreeFile ' Get unused file ' number. Open "c:\Findlog" For Output As #FileNumber With Application.FileSearch .NewSearch .LookIn = "\\server\folder1\folder2\" .SearchSubFolders = False .Filename = "*.xls" .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then For i = 1 To .FoundFiles.Count Set wb = Workbooks.Open(Filename:=.FoundFiles(i)) If SheetExists("Test", wb) Then fname = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) wb.ActiveSheet.Range("G5:G" & _ wb.ActiveSheet.Range("D65536").End(xlUp).row).Valu e = fname wb.ActiveSheet.Range("A5:G" & _ wb.ActiveSheet.Range("D65536").End(xlUp).row).Copy ThisWorkbook.Worksheets("Consol").Range("A" & _ ThisWorkbook.Worksheets("Consol").Range("D65536"). End(xlUp).Offset(1, 0).row).PasteSpecial _ Paste:=xlPasteValues wb.Close savechanges:=False fname = "" Else Write #FileNumber, wb.FullName End If Next i Else MsgBox "Folder " & sFolder & " contains no required files" End If End With Close #FileNumber Application.ScreenUpdating = True Application.DisplayAlerts = True '----------------------------------------------------------------- Function SheetExists(Sh As String, _ Optional wb As Workbook) As Boolean '----------------------------------------------------------------- Dim oWs As Worksheet If wb Is Nothing Then Set wb = ActiveWorkbook On Error Resume Next SheetExists = CBool(Not wb.Worksheets(Sh) Is Nothing) On Error GoTo 0 End Function -- HTH RP (remove nothere from the email address if mailing direct) "Steph" wrote in message ... Hi. The below code opens all files within a given folder, and consolidates them into 1 file, 1 sheet. In each of the files to be consolidated, I have a veryhidden sheet called Test. Is there a way to have the code open files within the folder and consolidate ONLY the files that contain the sheet Test? These files are templates that are being emailed in. I just want to make sure that the file I get back is my file, so the formats are exactly the same. Also, it would be great to write a log to a text file that detailed the names of the files that were not consolidated becasue they did not contain the sheet Test. Thanks in advance for any and all of your help Dim sFolder As String Dim wb As Workbook Dim i As Long Dim fname As String Application.ScreenUpdating = False Application.DisplayAlerts = False Sheets("Consol").Select With Application.FileSearch .NewSearch .LookIn = "\\server\folder1\folder2\" .SearchSubFolders = False .filename = "*.xls" .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then For i = 1 To .FoundFiles.Count Set wb = Workbooks.Open(filename:=.FoundFiles(i)) fname = Left(ActiveWorkbook.name, Len(ActiveWorkbook.name) - 4) wb.ActiveSheet.Range("G5:G" & _ wb.ActiveSheet.Range("D65536").End(xlUp).Row).Valu e = fname wb.ActiveSheet.Range("A5:G" & _ wb.ActiveSheet.Range("D65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets("Consol").Range("A" & _ ThisWorkbook.Worksheets("Consol").Range("D65536"). End(xlUp).Offset(1, 0).Row).PasteSpecial _ Paste:=xlPasteValues wb.Close savechanges:=False fname = Nothing Next i Else MsgBox "Folder " & sFolder & " contains no required files" End If End With Application.ScreenUpdating = True Application.DisplayAlerts = True |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| emailing files from excel, the files will not go until I open up . | New Users to Excel | |||
| how do I toggle between 2 open excel files and leave both open | Excel Discussion (Misc queries) | |||
| How to change default Open/Files of Type to "Microsoft Excel Files | Excel Discussion (Misc queries) | |||
| I cant open files unless I open the Excel program first | Excel Discussion (Misc queries) | |||
| file open via IE hyperlink causes already open files to shrink and tile | Setting up and Configuration of Excel | |||
![Steph[_3_] is offline](https://www.excelbanter.com/images/SultanThemeVB3R/statusicon/user_offline.gif)
Linear Mode
