DEVelopers HUT

'---------------------------------------------------------------------------------------
' 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