VBA loop to create named .csv files for all worksheets and workbooks in a folder

K

KQBats

Hi all

I don't have a great deal of experience with VBA, but can usually muddl
my way through. I have drawn a blank with the following, however.

I have a folder containing multiple excel workbooks, all of which are o
the same structure. The workbooks contain multiple work sheets. I wan
to write a macro that saves each worksheet within each workbook as
separate .csv file that is named "NameofWorkBook_NameofWorkSheet". Thes
would all be saved into the existing folder.

I have been reading threads on similar topics and trying to meld the
together, but the best I have been able to do is save each workshee
within a single workbook as the name of the worksheet. I am using Exce
2010. Any assistance with sample code, or directing me to where this ha
previously been addressed would be most appreciated.

Thanks in advance..
 
G

Gord Dibben

This code OK in 2007 for one workbook only.

You will have to add a loop to go through all workbooks in the folder.

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:=ThisWorkbook.Path & "\" & ThisWorkbook.Name _
& "_" & w.Name & FileExtStr
.Close
End With
Next w
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Gord
 
K

KQBats

Gord - Thanks, that works well. I will pop it into a loop and
hopefully, get the whole lot done in one hit. Really appreciate you
time.

Cheers

Ken

'Gord Dibben[_2_ said:
;1601526']This code OK in 2007 for one workbook only.

You will have to add a loop to go through all workbooks in the folder.

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:=ThisWorkbook.Path & "\" & ThisWorkbook.Name _
& "_" & w.Name & FileExtStr
.Close
End With
Next w
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Gord

On Sat, 5 May 2012 11:24:31 +0000, KQBats
Hi all

I don't have a great deal of experience with VBA, but can usuall muddle
my way through. I have drawn a blank with the following, however.

I have a folder containing multiple excel workbooks, all of which ar of
the same structure. The workbooks contain multiple work sheets. I want
to write a macro that saves each worksheet within each workbook as a
separate .csv file that is named "NameofWorkBook_NameofWorkSheet" These
would all be saved into the existing folder.

I have been reading threads on similar topics and trying to meld them
together, but the best I have been able to do is save each worksheet
within a single workbook as the name of the worksheet. I am usin Excel
2010. Any assistance with sample code, or directing me to where thi has
previously been addressed would be most appreciated.

Thanks in advance...
 
K

KQBats

OK, I am nearly there. All of the files are being produced for all th
workbooks, but I am not getting the name of the file correct when I ru
the code from within the loop to run the saving in batch mode, and it i
saving the csv files back to the "C:\" directory, rather than the one i
which the files are sitting "C:\Datafiles". The code below is saving th
files as Book1_WorksheetName.csv through to Book(number of worksheets i
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 quit
getting the 'ActiveWorkBook' and 'ThisWorkBook' elements right, and hav
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
 
G

Gord Dibben

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
 
K

KQBats

Gord

Yes, I did because I wasn't sure about how to have the correct workboo
referenced as the loop calls the "Make_New_Books" code. The code yo
posted works without the loop if the macro is run from within th
workbook that I am wishing to break into the sheets and save, but i
doesn't correctly name them if I open a workbook with th
"AllFolderFiles" macro in it, and call the "Make_New_Books" code fro
within that Macro.

The "AllFolderFiles" macro contains a loop to move through all the file
in the folder, but it is not passing the name of the current file tha
it is working on to the "Make_New_Books" macro when it saves th
files...at least I think that is the case.

Cheers

Ken

'Gord Dibben[_2_ said:
;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
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 run
the code from within the loop to run the saving in batch mode, and i is
saving the csv files back to the "C:\" directory, rather than the on in
which the files are sitting "C:\Datafiles". The code below is savin the
files as Book1_WorksheetName.csv through to Book(number of worksheet 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 no quite
getting the 'ActiveWorkBook' and 'ThisWorkBook' elements right, an 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: -
 
G

Gord Dibben

I'll tool around with it tomorrow when I get time.


Gord

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_ said:
;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
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--
 
G

Gord Dibben

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



I'll tool around with it tomorrow when I get time.


Gord

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_ said:
;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
-

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--
 
G

Gord Dibben

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

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



I'll tool around with it tomorrow when I get time.


Gord

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
-

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--
 
G

Gord Dibben

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

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

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



I'll tool around with it tomorrow when I get time.


Gord

On Mon, 7 May 2012 09:38:20 +0000, KQBats


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
-

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--
 
K

KQBats

Gord - THANKS!!!! You are a legend. That works perfectly.

Ken.


'Gord Dibben[_2_ said:
;1601649']I am getting bad results in CSV formatting using this strin
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

-
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

-
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



-
I'll tool around with it tomorrow when I get time.


Gord

On Mon, 7 May 2012 09:38:20 +0000, KQBats


Gord

Yes, I did because I wasn't sure about how to have the correc workbook
referenced as the loop calls the "Make_New_Books" code. The cod 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, bu it
doesn't correctly name them if I open a workbook with the
"AllFolderFiles" macro in it, and call the "Make_New_Books" cod 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
-

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-----
 
G

Gord Dibben

Thanks.......after enough revisions I think we'll leave it alone<g>

Gord

Gord - THANKS!!!! You are a legend. That works perfectly.

Ken.


'Gord Dibben[_2_ said:
;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

-
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

-
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



-
I'll tool around with it tomorrow when I get time.


Gord

On Mon, 7 May 2012 09:38:20 +0000, KQBats


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
-

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-----
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top