ustcer: January 2015

Wednesday, January 28, 2015

VBA - How to convert xls, xlsx files in a directory to csv

Sub SaveToCSVs()
Dim fDir As String
Dim wB As Workbook
Dim wS As Worksheet
Dim csvWs As String, csvWb As String
Dim extFlag As Long '0 = .xls & 1 = .xlsx extension types
Dim fPath As String
Dim sPath As String, dd() As String
fPath = "C:\Documents and Settings\mvasas\Desktop\VBA\Dev\_My_Projects\"
sPath = "C:\Documents and Settings\mvasas\Desktop\VBA\Dev\_My_Projects\"
fDir = Dir(fPath)
extFlag = 2
Do While (fDir <> "")
If Right(fDir, 4) = ".xls" Then
extFlag = 0
Else
extFlag = 2
End If
If Right(fDir, 5) = ".xlsx" Then
extFlag = 1
Else
extFlag = 2
End If
On Error Resume Next
If extFlag = 2 Then
fDir = Dir
ElseIf extFlag = 1 Then
Set wB = Workbooks.Open(fPath & fDir)
csvWb = wB.Name
'Be careful here, this split will split a string into an array
'with a dot (.) delimeter. The string is the name of the workbook
'testing was performed on workbooks where the only dots were at
'the extension ie: CSVSAVERTESTFILE.xlsx. If there is a file with
'a name like, CSV.SAVER.TEST.FILE.xlsx, the file will be renamed:
'CSV.Sheet1.csv as the code takes the first String value in the
'array as the new name.
dd = Split(csvWb, ".")
For Each wS In wB.Sheets
wS.SaveAs sPath & dd(0) & "-" & wS.Name & ".csv", xlCSV
Next wS
wB.Close False
Set wB = Nothing
fDir = Dir
On Error GoTo 0
End If
Loop
End Sub

MS Access – VBA – Convert Excel XLS to CSV

What is also nice about the way it is written, is that it will run in any MS Office application (MS Access, MS Word, MS PowerPoint, MS Outlook, …) without requiring any modifications (copy & paste, that’s it)!

'---------------------------------------------------------------------------------------
' Procedure : ConvertXls2CSV
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Converts a standard Excel file to csv format
' Requirements: Requires MS Excel be installed
'               Uses late binding, so no libraries need be declared
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sXlsFile  : Fully qualified path and filename with extension of the Excel workbook
'
' Usage:
' ~~~~~~
' ConvertXls2CSV "C:\Users\Daniel\Desktop\Contact_E-mail listing.xls"
'       Will output a file C:\Users\Daniel\Desktop\Contact_E-mail listing.csv
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2012-May-11             Initial Release - Answer to forum question
'---------------------------------------------------------------------------------------
Function ConvertXls2CSV(sXlsFile As String)
    On Error Resume Next
    Dim oExcel          As Object
    Dim oExcelWrkBk     As Object
    Dim bExcelOpened    As Boolean    'Was Excel already open or not
    'Review 'XlFileFormat Enumeration' for more formats
    Const xlCSVWindows = 23 'Windows CSV Format
    Const xlCSV = 6 'CSV
    Const xlCSVMac = 22 'Macintosh CSV
    Const xlCSVMSDOS = 24 'MSDOS CSV

    Set oExcel = GetObject(, "Excel.Application")    'Bind to existing instance of Excel

    If Err.Number <> 0 Then    'Could not get instance of Excel, so create a new one
        Err.Clear
        On Error GoTo Error_Handler
        Set oExcel = CreateObject("excel.application")
        bExcelOpened = False
    Else    'Excel was already running
        bExcelOpened = True
    End If
 
    On Error GoTo Error_Handler
    oExcel.ScreenUpdating = False
    oExcel.Visible = False   'Keep Excel hidden from the user
    oExcel.Application.DisplayAlerts = False
 
    Set oExcelWrkBk = oExcel.Workbooks.Open(sXlsFile)
    'Note: you may wish to change the file format constant for another type declared
    '      above based on your usage/needs in the following line.
    oExcelWrkBk.SaveAs Left(sXlsFile, InStrRev(sXlsFile, ".")) & "csv", xlCSVWindows
    oExcelWrkBk.Close False
 
    If bExcelOpened = False Then
        oExcel.Quit
    End If
 
Error_Handler_Exit:
    On Error Resume Next
    Set oExcelWrkBk = Nothing
    Set oExcel = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: ConvertXls2CSV" & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

Now this could be further improved by extending the error handling further to trap specific errors such as 1004 – file not found, etc… but it definitely illustrates the basic principle in using late binding to utilize Excel to open the file and convert it to *.csv format.