OPEN: Excel Macro Save As with a new file name

[mokk083]

Microsoft Excel 2010


Sub XLS_TO_CSV()
'
' XLS_TO_CSV Macro
'
' Keyboard Shortcut: Ctrl+m
'
Application.ActiveProtectedViewWindow.Edit
ChDir "C:\Users\mokk083\Desktop\Work in Progress\Graduate"
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\mokk083\Desktop\Work in Progress\Graduate\File_Name_1" _
, FileFormat:=xlCSV, CreateBackup:=False
End Sub

Hello,

I have to open up over 100 .xls files, and save as individually as a .csv comma delimited file.

I used the record macro button, and I got the above code.

However, the issue is when I open up a second file and run the macro, NOT File_Name_1 ie File_Name_2, it saves as File_Name_1. I don't know what to put in ActiveWorkbook.SaveAs Filename:=, and I need help. I wish that the macro would take the file name, and save it using that file name, instead of the file name I used when I first recorded the macro.

Also, I dont know if ChDir "C:\Users\mokk083\Desktop\Work in Progress\Graduate" will make it so the macro only save the file in that specific folder.
Can anyone please tell me how to make it so it default saves in the folder that the original file was in?

Thank you,
Ka

Edit: Is there another way (free) that anyone knows to convert bulks of .xls to .csv?

[vert]

Try this out.


Sub SaveCSV()

Dim path As String, excelfile As String, fname As Variant
path = "C:\Users\mokk083\Desktop\Work in Progress\Graduate\"
ChDir path
excelfile = Dir(path & "*.xls")
Do While excelfile <> ""
fname = Split(excelfile, ".")
Workbooks.Open filename:=path & excelfile
ActiveWorkbook.SaveAs filename:=path & fname(0), FileFormat:=xlCSV
ActiveWorkbook.Close
excelfile = Dir
Loop

End Sub

[mokk083]

Hello,

Thank you very much.

From what I can tell, if I edit the 2nd line,
path = "C:\Users\mokk083\Desktop\Work in Progress\Graduate\", I can change what folder to put all the .XLS files into.

As I changed :
path = "C:\Users\mokk083\Desktop\Work in Progress\Graduate\" to path = "C:\Users\mokk083\Desktop\Work in Progress\", I was hoping that it would convert all .XLS in the Work In Progress folder, including all subfolders. But it doesn't. Is it possible to make it so ALL subfolders inside C:\Users\mokk083\Desktop\Work in Progress\ to convert to .csv?

Also, Can anyone tell me a good source for me to learn about other aspects of this code? such as what Loop, Do While, Dir(path & "*.xls"). I want to help other people on the forum in the future. I am a total beginner.

Ka

[vert]

That will only look into the files in the "path" folder not sub folders. Try this to look into all the sub folders.


Sub SaveCSV_AllFolders()

Dim FileSys As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim Path As String, excelfile As String, fname As Variant

Set FileSys = CreateObject("Scripting.FileSystemObject")
Set objFolder = FileSys.GetFolder("C:\Users\mokk083\Desktop\Work in Progress\")

excelfile = Dir(objFolder & "\*.xls")
Do While excelfile <> ""
fname = Split(excelfile, ".")
Workbooks.Open filename:=objFolder & "\" & excelfile
ActiveWorkbook.SaveAs filename:=objFolder & "\" & fname(0), FileFormat:=xlCSV
ActiveWorkbook.Close
excelfile = Dir
Loop

For Each objSubFolder In objFolder.SubFolders
excelfile = Dir(objSubFolder & "\*.xls")
Do While excelfile <> ""
fname = Split(excelfile, ".")
Workbooks.Open filename:=objSubFolder & "\" & excelfile
ActiveWorkbook.SaveAs filename:=objSubFolder & "\" & fname(0), FileFormat:=xlCSV
ActiveWorkbook.Close
excelfile = Dir
Loop
Next

End Sub




Also, Can anyone tell me a good source for me to learn about other aspects of this code? such as what Loop, Do While, Dir(path & "*.xls"). I want to help other people on the forum in the future. I am a total beginner.

I can't figure out how to post a link. I keep getting an error. There is a thread on here with a lot of good resources. Try searching for "need to concentrate on VBA itself".

[westconn1]

@ vert
i would believe that your code would only work to first level subfolders, better to use recursive procedure to do all levels of subfolders

[vert]

westconn1,

Thanks, I wasn't even thinking multi level subfolders.


Sub SeachXLS()
Dim FileSys As Object
Dim objFolder As Object

Set FileSys = CreateObject("Scripting.FileSystemObject")
Set objFolder = FileSys.GetFolder("C:\Users\mokk083\Desktop\Work in Progress\")

RecursiveSearch objFolder, "*.xls"

Set objFolder = Nothing
Set FileSys = Nothing
End Sub

Sub RecursiveSearch(Folder As Object, Search As String)
Dim Fld As Object
Dim File As Object
dim fname as Variant

For Each Fld In Folder.SubFolders
RecursiveSearch Fld, Search
Next

For Each File In Folder.Files
fname = Split(File.Name, ".")
If fname(1) Like "xls*" Then
Workbooks.Open filename:=File
ActiveWorkbook.SaveAs filename:=Folder & "\" & fname(0), FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
End If
Next
End Sub