Converting CSV files to Excel workbooks

Question

My converter converts all CSV files in the subfolders of folders 1, 2 & 3 into Excel workbooks. As of now, I am converting using codes for each folders. I previously tried to combine those into one using for loop, but an error occurred, so I've rolled back to the working code I had before the loop.

Can anyone show me how to clean this up with a loop or another method?

Private Sub CommandButton1_Click()
 Dim CSVfolder As String, CSVfolder1 As String, CSVfolder2 As String
 Dim fname, fname1, fname2 As String
 Dim wBook As Workbook
 Dim colSF As Collection
 Dim vFile, vFile1, vFile2
 Dim bHadFiles As Boolean
 CSVfolder = "C:\Charts1円\"
 CSVfolder1 = "C:\Charts2円\"
 CSVfolder2 = "C:\Charts3円\"
 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
Set colSF = GetSubFolders(CSVfolder1)
For Each vFile1 In colSF
fname1 = Dir(CSVfolder1 & vFile1 & "\" & "*.csv")
Do While fname1 <> ""
 bHadFiles = True
 Application.ScreenUpdating = False
 Set wBook = Workbooks.Open(CSVfolder1 & vFile1 & "\" & fname1, Format:=6, Delimiter:=",")
 wBook.SaveAs CSVFolder1 & vFile1 & "\" & Replace(fname1, ".csv", ""), xlOpenXMLWorkbook
 Application.CutCopyMode = False
 wBook.Close False
fname1 = Dir()
 Loop
 If bHadFiles Then Kill CSVfolder1 & vFile1 & "\" & "*.csv"
 Next
Set colSF = GetSubFolders(CSVfolder2)
For Each vFile2 In colSF
fname2 = Dir(CSVfolder2 & vFile2 & "\" & "*.csv")
Do While fname2 <> ""
 Application.ScreenUpdating = False
 Set wBook = Workbooks.Open(CSVfolder2 & vFile2 & "\" & fname2, Format:=6, Delimiter:=",")
 wBook.SaveAs CSVFolder2 & vFile2 & "\" & Replace(fname2, ".csv", ""), xlOpenXMLWorkbook
 Application.CutCopyMode = False
 wBook.Close False
 fname2 = Dir()
 Loop
 If bHadFiles Then Kill CSVfolder2 & vFile2 & "\" & "*.csv"
 Next
 Application.ScreenUpdating = True
 End Sub
Function GetSubFolders(sPath As String) As Collection
 Dim col As New Collection, f
 f = Dir(sPath, vbDirectory + vbNormal)
 Do While f <> ""
 If GetAttr(sPath & f) And vbDirectory Then
 If f <> "." And f <> ".." Then col.Add f
 End If
 f = Dir()
 Loop
 Set GetSubFolders = col
End Function

• RubberDuck: I made a pretty significant edit to get this on topic. If you're interested in fixing that particular error in the 2nd piece of code, I recommend stack overflow. However, I think you and this code would benefit from a general review, so I wanted to salvage the question.

Answer 1

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:\Charts1円\"
 CSVfolder1 = "C:\Charts2円\"
 CSVfolder2 = "C:\Charts3円\"
 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

• Abdul Shiyas: Thank you Professor Duck! You are awesome!! I am into this excel-vba for last 4-5 weeks. Thanks for valuable advices.
• RubberDuck: You're very welcome. I improved your suggested edit. I meant to create a constant for the root directory and had forgotten.
• ChipsLetten: @RubberDuck - looks like you've forgotten to include the Application.ScreenUpdating = False line in your final code although it is included in the code further up your answer.
• ChipsLetten: In the past I had seen somewhere that Dir internally caches the path given to it (which is how subsequent calls return the next match) and therefore you should avoid making nested calls to it using different paths. I'm guessing that you encounter no issues with this code?
• RubberDuck: Thanks @ChipsLetten. It took a bit to write this. Im away from my machine atm. Would you mind suggesting an edit?

Answer 2

I agree with everything suggested by @RubberDuck but wanted to show how the code could be written to remove the need for the hard-coded list of subfolders at the very beginning.

folders.Add "1"
folders.Add "2"
folders.Add "3"

The existing GetSubFolders also doesn't dig into further levels of subfolders and the Dir function starts throwing errors if you try to use it recursively.

There is also an argument to be made that TransformFile is doing more than one thing because it is finding subfolders and transforming the files it finds.

I have changed GetSubFolders from a function to a procedure that takes both the starting path and the Collection that must get populated. This way the procedure can call itself whenever it finds a subfolder so that it can look within that folder for a further level of subfolders. It also now uses the FileSystemObject from the Microsoft Scripting Runtime. You will need to set a reference to this library - from the VBA IDE select the Tools -> References menu. Scroll down until you find the "Microsoft Scripting Runtime" entry and check the box.

The revised code now populates a collection with all the folders found below the path of the folder passed to it.

Private Sub GetSubFolders(ByRef sPath As String, ByRef theFolders As Collection)
 Dim fileSystem As Scripting.FileSystemObject
 Dim subFolder As Scripting.Folder
 Set fileSystem = New FileSystemObject
 For Each subFolder In fileSystem.GetFolder(sPath).SubFolders
 theFolders.Add fileSystem.BuildPath(subFolder.Path, "")
 ' Also look for another level of folders
 Call GetSubFolders(subFolder.Path, theFolders)
 Next subFolder
End Sub

The main procedure becomes:

Private Sub CommandButton1_Click()
 Application.ScreenUpdating = False
 Const rootFolder As String = "C:\Charts\"
 Dim theFolders As New Collection
 Call GetSubFolders(rootFolder, theFolders)
 Dim CSVFolder As Variant 'must be a variant in order to loop over a string collection
 For Each CSVFolder In theFolders
 Call TransformFile (CSVFolder)
 Next
 Application.ScreenUpdating = True
End Sub

And TransformFile gets changed as shown below. There is a design-decision as to whether the code should delete each csv file as it loops over them or just delete them all at the end.

Private Sub TransformFile(ByVal CSVFolder As String)
 Dim filename As String
 Dim wBook As Workbook
 Dim hadFiles As Boolean
 Dim filePath As String
 If Right(CSVFolder, 1) <> Application.PathSeparator Then
 filePath = CSVFolder & Application.PathSeparator
 Else
 filePath = CSVFolder
 End If
 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
 ' Maybe we should be deleting the csv file in case we get an error
 ' before we've finished all the files in this folder?
 ' This would be slower though
 'Kill filePath & filename
 filename = Dir()
 Loop
 If hadFiles Then
 Kill filePath & "*.csv"
 End If
End Sub

On a side-note, I personally use the Call keyword when making a call to a procedure but I have seen statements that it is deprecated and shouldn't be used.

• RubberDuck: [meta review] Mind if I ask a question? Why use ByRef to return the folders collection instead of a function? [/meta review]
• ChipsLetten: @RubberDuck - It feels like the cleanest solution. If it is a function then it either takes the current collection as a parameter and returns the updated collection or it just returns a collection and extra code is needed to to add the values from that one to the overall collection.
• RubberDuck: Interesting choice, but fair enough. I see what you mean.