One of my tasks recently was to simplify a data loading process. Part of this process involved creating Spreadsheets that were to be put on CD.
At the moment the program created a simple CSV file. We did try to just create an Excel file on the fly, but it was painfully slow, so a different direction was needed. We found that creating a CSV file and then converting it to an XLS was a lot quicker.
This conversion would also need to merge multiple CSV files into the one XLS file, plus because it included data, it also needed to be password protected.
First we need to reference the Microsoft Excel Object Library (mine was version 11), then we need to dimension our variables...
Dim oExcel As Excel.Application
Dim oBook As Workbook
Dim oBookSpare As Workbook
Dim oSheet As Worksheet
Dim oSheet2 As Worksheet
Dim strFiles() As String
Dim lngLoop As Long
These are for opening up multiple CSV files. This code is taken from the routine I created, and passed to this routine is one string containing all the CSV files we want in this XLS file.
' split files
strFiles = Split(strCSVFile, "|")
The above code splits the strCSVFile into seperate files for later. The paths are seperated by pipes.
Next we need to open the first CSV file, we do this with the following code.
' open first book
Set oBook = oExcel.Workbooks.Open(strFiles(0))
Next I needed to format a few columns, these had prices in and did not come out the way I needed them to when converting from a CSV, I also wanted to change the name that appeared on the tab to Sheet 1.
' format columns
oBook.Worksheets(1).Columns("S").NumberFormat = "#,###,##0.00"
oBook.Worksheets(1).Columns("U").NumberFormat = "#,###,##0.00"
oBook.Worksheets(1).Columns("V").NumberFormat = "#,###,##0.00"
oBook.Worksheets(1).Name = "Sheet1"
The next code checks to see if there were any more files sent, if there were then loop through each one, import it, then copy it to the current workbook we have been working on, rename this one as well and then finally do the format thing again.
' loop through any extra spreadsheets
If UBound(strFiles) > 0 Then
For lngLoop = 2 To UBound(strFiles) + 1
If Trim(strFiles(lngLoop - 1)) <> "" Then
' open extra one
Set oBookSpare = oExcel.Workbooks.Open(strFiles(lngLoop - 1))
Set oSheet = oBookSpare.Worksheets(1)
' import into new worksheet
oSheet.Copy , oBook.Worksheets(lngLoop - 1)
oBook.Worksheets(lngLoop).Name = "Sheet" & lngLoop
' format columns
oBook.Worksheets(lngLoop).Columns("S").NumberFormat = "#,###,##0.00"
oBook.Worksheets(lngLoop).Columns("U").NumberFormat = "#,###,##0.00"
oBook.Worksheets(lngLoop).Columns("V").NumberFormat = "#,###,##0.00"
End If
Next lngLoop
End If
That pretty much the meat of it, one of the last thing we want to do now is save it, as an Excel file, with a password.
' save file as .xls with password
oBook.SaveAs "newfile.xls", xlExcel9795, "passwordhere"
Now we do some clearing up with closing everything.
' finish everything
Set oBook = Nothing
Set oBookSpare = Nothing
Set oSheet = Nothing
oExcel.Quit
Set oExcel = Nothing
And that was all there was to it. I did a test and it took about 45 seconds to convert a 45mb csv file, which was a lot quicker than our original way.
