The very first thing we need to do is fix the indentation. If we can't read the code, we can't make it better. Everything inside of Sub...End Sub should be one level in. Add another level when you enter an If, For, For Each, or Select.
Sub Foo
' some code
Set colSF = GetSubFolders(CSVfolder)
For Each vFile In colSF
fname = Dir(CSVfolder & vFile & "\" & "*.csv")
Do While fname <> ""
bHadFiles = True
Application.ScreenUpdating = False
Set wBook = Workbooks.Open(CSVfolder & vFile & "\" & fname, Format:=6, Delimiter:=",")
wBook.SaveAs CSVfolder & vFile & "\" & Replace(fname, ".csv", ""), xlOpenXMLWorkbook
Application.CutCopyMode = False
wBook.Close False
fname = Dir()
Loop
If bHadFiles Then Kill CSVfolder & vFile & "\" & "*.csv"
Next
' more code
End Sub
You had the right idea with the loop. A loop will definitely clean this up immensely, but before we get to a loop, first let's extract a method to remove the duplication.
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim CSVfolder As String, CSVfolder1 As String, CSVfolder2 As String
CSVfolder = "C:\Charts\1\"
CSVfolder1 = "C:\Charts\2\"
CSVfolder2 = "C:\Charts\3\"
TransformFile CSVfolder
TransformFile CSVfolder1
TransformFile CSVfolder2
Application.ScreenUpdating = True
End Sub
Private Sub TransformFile(ByVal CSVfolder As String)
Dim fname As String
Dim vFile
Dim colSF As Collection
Dim wBook As Workbook
Set colSF = GetSubFolders(CSVfolder)
For Each vFile In colSF
fname = Dir(CSVfolder & vFile & "\" & "*.csv")
Do While fname <> ""
bHadFiles = True
Set wBook = Workbooks.Open(CSVfolder & vFile & "\" & fname, Format:=6, Delimiter:=",")
wBook.SaveAs CSVfolder & vFile & "\" & Replace(fname, ".csv", ""), xlOpenXMLWorkbook
Application.CutCopyMode = False
wBook.Close False
fname = Dir()
Loop
If bHadFiles Then Kill CSVfolder & vFile & "\" & "*.csv"
Next
End Sub
Note that all I did was move the code into it's own method and call it appropriately. There's still no loop, but now moving to a loop is both trivial and almost unnecessary. We like clean code around here though, so let's go ahead and do that.
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim folders As New Collection
folders.Add "1"
folders.Add "2"
folders.Add "3"
'must be a variant in order to loop over a string collection
'using a string array instead of a collection is another good option
Dim CSVFolder As Variant
For Each CSVFolder In folders
TransformFile CSVFolder
Next
Application.ScreenUpdating = True
End Sub
I noticed you have this is a code behind, you may want to move this code to it's own module or class and call it from the click handler. That way your logic isn't bound up in the GUI where it can't be re-used. The only other thing to mention here is that if you're turning the screen updating off, then you must use an error handler to ensure that it always gets turned back on.
But we're not done yet, we extracted that method out, but left our mess hidden away in there. Let's clean it up too.
Private Sub TransformFile(ByVal CSVFolder As String)
Dim fname As String
Dim vFile
Dim colSF As Collection
Dim wBook As Workbook
Set colSF = GetSubFolders(CSVFolder)
For Each vFile In colSF
fname = Dir(CSVFolder & vFile & "\" & "*.csv")
Do While fname <> ""
bHadFiles = True
Application.ScreenUpdating = False
Set wBook = Workbooks.Open(CSVFolder & vFile & "\" & fname, Format:=6, Delimiter:=",")
wBook.SaveAs CSVFolder & vFile & "\" & Replace(fname, ".csv", ""), xlOpenXMLWorkbook
Application.CutCopyMode = False
wBook.Close False
fname = Dir()
Loop
If bHadFiles Then Kill CSVFolder & vFile & "\" & "*.csv"
Next
End Sub
How many times do you need to concatenate this path together?
CSVFolder & vFile & "\" & "*.csv"
Yikes! Do it once before you enter the while loop.
For Each vFile In colSF
filePath = CSVFolder & vFile & "\"
fname = Dir(filePath & "*.csv")
Do While fname <> ""
bHadFiles = True
Set wBook = Workbooks.Open(filePath & fname, Format:=6, Delimiter:=",")
wBook.SaveAs filePath & Replace(fname, ".csv", ""), xlOpenXMLWorkbook
Application.CutCopyMode = False
wBook.Close False
fname = Dir()
Loop
If bHadFiles Then Kill filePath & "*.csv"
Next
No offense, but WTF is colSF? It's a collection of folder names, right? Then just call it that. While we're at it, burn the hungarian notation. The name hadFiles already tells us that it's a boolean. I'm also going to add some vertical white space to group related actions together. Oh, and I'm going to remove Application.CutCopyMode = False. I seriously have no idea what it's doing here. It's not doing anything important at least.
Private Sub TransformFile(ByVal CSVFolder As String)
Dim filename As String
Dim vFile As Variant
Dim folderNames As Collection
Dim wBook As Workbook
Dim hadFiles As Boolean
Dim filePath As String
Set folderNames = GetSubFolders(CSVFolder)
For Each vFile In folderNames
filePath = CSVFolder & vFile & "\"
filename = Dir(filePath & "*.csv")
Do While filename <> ""
hadFiles = True
Set wBook = Workbooks.Open(filePath & filename, Format:=6, Delimiter:=",")
wBook.SaveAs filePath & Replace(filename, ".csv", ""), xlOpenXMLWorkbook
wBook.Close False
filename = Dir()
Loop
If hadFiles Then Kill filePath & "*.csv"
Next
End Sub
In general, don't oneline If statements. It makes them hard to visually parse. This is doubly important on lines of code that Kill files.
If hadFiles Then
Kill filePath & "*.csv"
End If
Things are getting better, but there's still a lot of variables. We can remove one by leaning on the face that colSF (i.e. folderNames) is never used as anything but an iterator.
Set folderNames = GetSubFolders(CSVFolder)
For Each vFile In folderNames
Becomes
For Each vFile In GetSubFolders(CSVFolder)
Don't worry about the function getting called repeatedly, it won't. It executes once and then we're iterating over the collection that it returned.
Here's the code I ended up with. It's probably not getting much simpler unless you switch to the more powerful FileSystemObject in the Scripting Runtime. I encourage you to take a look at what's available there and leave it as an exercise for you to implement this using it instead.
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Const rootFolder As String = "C:\Charts\"
Dim folders As New Collection
folders.Add "1"
folders.Add "2"
folders.Add "3"
Dim CSVFolder As Variant 'must be a variant in order to loop over a string collection
For Each CSVFolder In folders
TransformFile rootFolder & CSVFolder & "\"
Next
Application.ScreenUpdating = True
End Sub
Private Sub TransformFile(ByVal CSVFolder As String)
Dim filename As String
Dim vFile As Variant
Dim wBook As Workbook
Dim hadFiles As Boolean
Dim filePath As String
For Each vFile In GetSubFolders(CSVFolder)
filePath = CSVFolder & vFile & "\"
filename = Dir(filePath & "*.csv")
Do While filename <> ""
hadFiles = True
Set wBook = Workbooks.Open(filePath & filename, Format:=6, Delimiter:=",")
wBook.SaveAs filePath & Replace(filename, ".csv", ""), xlOpenXMLWorkbook
wBook.Close False
filename = Dir()
Loop
If hadFiles Then
Kill filePath & "*.csv"
End If
Next
End Sub
