I posted earlier about this script (http://tinyurl.com/ydbo3c)
searching for a way to select which file format to export to and Bob
Phillips kindly helped out. Unfortunately, if you choose an Excel
format it just save multiple copies of the original file instead of
exporting each file separately as an xls file. So I'll start over.

I want to use this Dave Peterson script (http://tinyurl.com/yd9dp3)
below to export all worksheets in all workbooks in a folder to separate
xls files. The script works as configured for csv files, but if you
change the line FileFormat:=xlCSV to xlWorkbookNormal or xlExcel9795
(seehttp://msdn2.microsoft.com/en-us/library/microsoft.office.interop.excel.xlfileformat.aspx),
the script doesn't work but saves multiple copies of each original xls
file with all the worksheets intact in each file.

Option Explicit
Private Sub CommandButton1_Click()

Dim myfiles() As String
Dim i As Integer
Dim myfile As String
Dim myfolder As String
Dim strpath As String
Dim strfilename As String

Dim wks As Worksheet

myfolder = InputBox("Enter complete path to the Excel files you wish to
convert to CSV format. Put an \ on the end of the path.", "Excel File
Folder Path")

With Application.FileSearch
.NewSearch
.LookIn = myfolder
.SearchSubFolders = True
.Filename = "*.xls"
If .Execute() 0 Then
ReDim Preserve myfiles(1 To .FoundFiles.Count)
Application.StatusBar = "Found Files: " &
..FoundFiles.Count
For i = 1 To .FoundFiles.Count
myfiles(i) = .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
Exit Sub
End If

End With

For i = LBound(myfiles) To UBound(myfiles)
Application.StatusBar = "Processing #" & i & ": " & myfiles(i)

Workbooks.Open Filename:=myfiles(i), ReadOnly:=True,
UpdateLinks:=False

For Each wks In ActiveWorkbook.Worksheets
wks.Activate
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs _
Filename:=Left(myfiles(i), Len(myfiles(i)) - 4) & "_" _
& wks.Name, _
FileFormat:=xlCSV
Application.DisplayAlerts = True
Next wks

ActiveWorkbook.Close savechanges:=False

Next i

Application.StatusBar = False

End Sub

See this example for one file
http://www.rondebruin.nl/copy6.htm

You can use the code from this macro in a loop
See my site for code to loop through all files in a folder
http://www.rondebruin.nl/tips.htm


--
Regards Ron de Bruin
http://www.rondebruin.nl



"socrtwo" wrote in message ps.com...
I posted earlier about this script (http://tinyurl.com/ydbo3c)
searching for a way to select which file format to export to and Bob
Phillips kindly helped out. Unfortunately, if you choose an Excel
format it just save multiple copies of the original file instead of
exporting each file separately as an xls file. So I'll start over.

I want to use this Dave Peterson script (http://tinyurl.com/yd9dp3)
below to export all worksheets in all workbooks in a folder to separate
xls files. The script works as configured for csv files, but if you
change the line FileFormat:=xlCSV to xlWorkbookNormal or xlExcel9795
(seehttp://msdn2.microsoft.com/en-us/library/microsoft.office.interop.excel.xlfileformat.aspx),
the script doesn't work but saves multiple copies of each original xls
file with all the worksheets intact in each file.

Option Explicit
Private Sub CommandButton1_Click()

Dim myfiles() As String
Dim i As Integer
Dim myfile As String
Dim myfolder As String
Dim strpath As String
Dim strfilename As String

Dim wks As Worksheet

myfolder = InputBox("Enter complete path to the Excel files you wish to
convert to CSV format. Put an \ on the end of the path.", "Excel File
Folder Path")

With Application.FileSearch
.NewSearch
.LookIn = myfolder
.SearchSubFolders = True
.Filename = "*.xls"
If .Execute() 0 Then
ReDim Preserve myfiles(1 To .FoundFiles.Count)
Application.StatusBar = "Found Files: " &
.FoundFiles.Count
For i = 1 To .FoundFiles.Count
myfiles(i) = .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
Exit Sub
End If

End With

For i = LBound(myfiles) To UBound(myfiles)
Application.StatusBar = "Processing #" & i & ": " & myfiles(i)

Workbooks.Open Filename:=myfiles(i), ReadOnly:=True,
UpdateLinks:=False

For Each wks In ActiveWorkbook.Worksheets
wks.Activate
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs _
Filename:=Left(myfiles(i), Len(myfiles(i)) - 4) & "_" _
& wks.Name, _
FileFormat:=xlCSV
Application.DisplayAlerts = True
Next wks

ActiveWorkbook.Close savechanges:=False

Next i

Application.StatusBar = False

End Sub

Ron de Bruin wrote:
See this example for one file
http://www.rondebruin.nl/copy6.htm

You can use the code from this macro in a loop
See my site for code to loop through all files in a folder
http://www.rondebruin.nl/tips.htm


--
Regards Ron de Bruin
http://www.rondebruin.nl


Mr de Bruin. Thanks for taking an interest and replying. Your Website
is great. I think I've got everything working the way I need.

SIncerely Paul Pruitt (socrtwo)