Home |
Search |
Today's Posts |
#12
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Thanks.......after enough revisions I think we'll leave it alone<g
Gord On Thu, 10 May 2012 01:05:27 +0000, KQBats wrote: Gord - THANKS!!!! You are a legend. That works perfectly. Ken. 'Gord Dibben[_2_ Wrote: ;1601649']I am getting bad results in CSV formatting using this string in 2003 and 2007 ..................FileExtStr = ".csv": FileFormatNum = 6 I prefer the following change in file format property. If no problem in 2010 don't bother. Sub Make_New_Books() Dim WB As Workbook Dim FileExtStr As String Dim TheFile As String Dim MyPath As String Dim w As Worksheet MyPath = "C:\DataFiles" ChDir MyPath TheFile = Dir("*.xls") Application.ScreenUpdating = False Application.DisplayAlerts = False Do While TheFile < "" Set WB = Workbooks.Open(MyPath & "\" & TheFile) For Each w In ActiveWorkbook.Worksheets w.Copy With ActiveWorkbook .SaveAs Filename:=WB.Path & "\" _ & Left(WB.Name, Len(WB.Name) - 4) _ & "_" & w.Name, FileFormat:= _ xlCSVMSDOS .Close End With Next w WB.Close TheFile = Dir Loop Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Gord On Tue, 08 May 2012 10:34:32 -0700, Gord Dibben wrote: - Let's get rid of the .xls extension on WB.Name Sub Make_New_Books() Dim WB As Workbook Dim FileExtStr As String Dim TheFile As String Dim MyPath As String Dim w As Worksheet MyPath = "C:\DataFiles" FileExtStr = ".csv": FileFormatNum = 6 ChDir MyPath TheFile = Dir("*.xls") Application.ScreenUpdating = False Application.DisplayAlerts = False Do While TheFile < "" Set WB = Workbooks.Open(MyPath & "\" & TheFile) For Each w In ActiveWorkbook.Worksheets w.Copy With ActiveWorkbook .SaveAs Filename:=WB.Path & "\" _ & Left(WB.Name, Len(WB.Name) - 4) _ & "_" & w.Name & FileExtStr .Close End With Next w WB.Close TheFile = Dir Loop Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Gord On Tue, 08 May 2012 10:05:02 -0700, Gord Dibben wrote: - Put it all into one Sub Sub Make_New_Books() Dim WB As Workbook Dim FileExtStr As String Dim TheFile As String Dim MyPath As String Dim w As Worksheet MyPath = "C:\DataFiles" FileExtStr = ".csv": FileFormatNum = 6 ChDir MyPath TheFile = Dir("*.xls") Application.ScreenUpdating = False Application.DisplayAlerts = False Do While TheFile < "" Set WB = Workbooks.Open(MyPath & "\" & TheFile) For Each w In ActiveWorkbook.Worksheets w.Copy With ActiveWorkbook .SaveAs Filename:=WB.Path & "\" & WB.Name _ & "_" & w.Name & FileExtStr .Close End With Next w WB.Close TheFile = Dir Loop Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Gord On Mon, 07 May 2012 20:14:03 -0700, Gord Dibben wrote: - I'll tool around with it tomorrow when I get time. Gord On Mon, 7 May 2012 09:38:20 +0000, KQBats wrote: Gord Yes, I did because I wasn't sure about how to have the correct workbook referenced as the loop calls the "Make_New_Books" code. The code you posted works without the loop if the macro is run from within the workbook that I am wishing to break into the sheets and save, but it doesn't correctly name them if I open a workbook with the "AllFolderFiles" macro in it, and call the "Make_New_Books" code from within that Macro. The "AllFolderFiles" macro contains a loop to move through all the files in the folder, but it is not passing the name of the current file that it is working on to the "Make_New_Books" macro when it saves the files...at least I think that is the case. Cheers Ken 'Gord Dibben[_2_ Wrote: ;1601555']You altered my original code............. SaveAs Filename:=ActiveWorkbook.Path & "\" & ActiveWorkbook.Name _ & "_" & w.Name & FileExtStr ActiveWorkbook is the one that was just created and has no name or path. My code was.......... SaveAs Filename:=ThisWorkbook.Path & "\" & ThisWorkbook.Name _ & "_" & w.Name & FileExtStr Gord On Sun, 6 May 2012 02:37:21 +0000, KQBats wrote: - OK, I am nearly there. All of the files are being produced for all the workbooks, but I am not getting the name of the file correct when I run the code from within the loop to run the saving in batch mode, and it is saving the csv files back to the "C:\" directory, rather than the one in which the files are sitting "C:\Datafiles". The code below is saving the files as Book1_WorksheetName.csv through to Book(number of worksheets in all the workbooks)_WorksheetName.csv. Here is the code(Gord's first, followed by the loop that calls it). After I run this I run 'save all' and 'close all' macros. I am not quite getting the 'ActiveWorkBook' and 'ThisWorkBook' elements right, and have been playing around with these trying to get it to work. Sub Make_New_Books() Dim w As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False FileExtStr = ".csv": FileFormatNum = 6 For Each w In ActiveWorkbook.Worksheets w.Copy With ActiveWorkbook SaveAs Filename:=ActiveWorkbook.Path & "\" & ActiveWorkbook.Name _ & "_" & w.Name & FileExtStr Close End With Next w Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Sub AllFolderFiles() Dim WB As Workbook Dim TheFile As String Dim MyPath As String MyPath = "C:\DataFiles" ChDir MyPath TheFile = Dir("*.xls") Do While TheFile < "" Set WB = Workbooks.Open(MyPath & "\" & TheFile) Call Make_New_Books TheFile = Dir Loop End Sub KQBats;1601529 Wrote: - Gord - Thanks, that works well. I will pop it into a loop and, hopefully, get the whole lot done in one hit. Really appreciate your time. Cheers Ken----- |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Need to Export All Worksheets from All Workbooks in Folder to Separate FIles not as CSV Files | Excel Programming | |||
Loop through folder of workbooks and add rows | Excel Worksheet Functions | |||
Loop thru All Files in a Folder | Excel Programming | |||
Loop through all files in a folder | Excel Programming | |||
Loop through workbooks in a folder and return the value of cell M43 | Excel Programming |