ustcer: 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.

ustcer

Wednesday, January 28, 2015

MS Access – VBA – Convert Excel XLS to CSV

No comments:

Links