[VB6] Convert CSV to Excel Using ADO

[LaVolpe]

A piece of code I thought might be useful to some. Caveat first... Won't be the ideal solution for everyone.

Having Microsoft Excel on the computer is not a requirement. Including an ADO reference is. This code was tested using both ADO Library versions 2.8 and 6.1. The ADO dependency could be removed if code tweaked to use late-binding CreateObject() like VB scripts do.

This is unicode-friendly regarding file names. There are comments in the code should anyone want to tweak it to handle unicode file content. The routine will default to the more modern versions of Excel and can be forced to use the lower versions as desired.

A few common options are provided as function parameters and a schema.ini file would likely be needed for more complex options. Comments in the code talk a bit about that.

The code is really simple and allows ADO to do 100% of the work. Most of the routine below consists of sanity checks along with dealing with various options. The guts is an ADO connection to the csv file and an SQL execution on that connection to create the Excel file, create the tab/sheet, and copy the csv content to that sheet -- all done in that one execution.

 ' API used to check if file exists
Private Declare Function GetFileAttributes Lib "kernel32.dll" Alias "GetFileAttributesW" (ByVal lpFileName As Long) As Long

Private Function ConvertCSVtoExcel(CsvFile As String, _
                            Optional CsvHasHeaders As Boolean = True, _
                            Optional ExcelSheetName As String = "Sheet1", _
                            Optional ByVal ExcelVersion8 As Boolean = False, _
                            Optional DestinationPath As String = vbNullString, _
                            Optional ReturnedErrorString As String) As String

    ' Function will return full Excel file path & name if no errors & ReturnedErrorString will be null
    '   else function returns vbNullString and ReturnedErrorString contains error description
    '   Converted file name will be the same as the CSV except having an Excel extension
    
    ' Unicode. Handles unicode file names & sheet names.
    ' For those that want to also handle unicode CSV data, you will want to pass a new parameter and
    '   modify this routine. Key google term: CharacterSet=Unicode
    
    ' ensure CsvFile exists before calling this function
    ' ensure DestinationPath has write-access. By default this path is same as CsvFile path
    ' ExcelVersion8 can be accessed by most versions of Excel except very, very old versions
    '   if absolutely needed, you may want to rework this to pass an exact version, i.e., 5, 8, 12, etc
    '   If parameter is False, v12 (xlsx extension) will be attempted & falls back to v8 if needed
    '   Version 12 driver can be found here & requires at least Win7
    '   https://www.microsoft.com/en-us/download/details.aspx?id=13255
    
    ' Last but not least, some additional info
    '   many delimited file options can be used, but require a schema.ini file & no changes in this routine
    '       i.e., other delimiter than comma, specifying column data types, different column header names, etc
    '       https://docs.microsoft.com/en-us/sql/odbc/microsoft/schema-ini-file-text-file-driver
    '   if you need to play with xlsb (binary files) vs xlsx files, remove the XML from the v12 connection string

    Static v12ProviderAbsent As Boolean
    Const E_NOPROVIDER As Long = 3706&

    Dim cn As ADODB.Connection, p As Long
    Dim sSrcFile As String, sSrcPath As String
    Dim sSQL As String, sDest As String
    Dim sHDRprop As String, sVersion As String
    
    ' sanity checks and prep
    p = InStrRev(CsvFile, "\")
    sSrcFile = Mid$(CsvFile, p + 1)
    sSrcPath = Left$(CsvFile, p)
    If DestinationPath = vbNullString Then
        sDest = sSrcPath
    ElseIf Right$(DestinationPath, 1) <> "\" Then
        sDest = DestinationPath & "\"
    Else
        sDest = DestinationPath
    End If
    If v12ProviderAbsent = True Then ExcelVersion8 = True
    p = InStrRev(sSrcFile, ".")
    If p = 0 Then sDest = sDest & "." Else sDest = sDest & Left$(sSrcFile, p)
    If ExcelVersion8 Then sDest = sDest & "xls" Else sDest = sDest & "xlsx"
    If ExcelSheetName = vbNullString Then ExcelSheetName = "Data"
    If CsvHasHeaders Then sHDRprop = "Yes" Else sHDRprop = "No"
    
    ' prevent overwriting existing file; Excel file creation fails if file/sheet already exists
    Do
        If GetFileAttributes(StrPtr(sDest)) = -1& Then Exit Do
        If ExcelVersion8 Then sDest = sDest & ".xls" Else sDest = sDest & ".xlsx"
    Loop
    
    ' verify we can open the csv
    On Error Resume Next
    Set cn = New ADODB.Connection
    cn.CursorLocation = adUseClient
    If Not ExcelVersion8 Then
        cn.ConnectionString = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & _
            sSrcPath & ";Extended Properties='text;HDR=" & sHDRprop & ";FMT=CSVDelimited'"
        cn.Open
        If Err Then ' failure. Either version 12 not installed or O/S less than Win7
            If Err.Number = E_NOPROVIDER Then v12ProviderAbsent = True
            ExcelVersion8 = True                ' try again using lower Excel version
            sDest = Left$(sDest, Len(sDest) - 1)
            Err.Clear
        Else
            sVersion = "12.0 XML"
        End If
    End If
    If ExcelVersion8 Then
        cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
            sSrcPath & ";Extended Properties='text;HDR=" & sHDRprop & ";FMT=CSVDelimited'"
        cn.Open
        If Err Then ' can't be done via this routine
            ReturnedErrorString = Err.Description
            Err.Clear
            GoTo ExitRoutine
        End If
        sVersion = "8.0"
    End If
    
    ' create the excel file, sheet, & import data in one call
    sSQL = "SELECT * INTO [" & ExcelSheetName & "] IN '' [Excel " & sVersion & _
            ";Database=" & sDest & "] FROM [" & sSrcFile & "]"
    cn.Execute sSQL
    If Err Then
        ReturnedErrorString = Err.Description
        Err.Clear
    Else
        ReturnedErrorString = vbNullString
        ConvertCSVtoExcel = sDest
    End If
    
ExitRoutine:
    If cn.State Then cn.Close
    Set cn = Nothing
End Function

Edited: A specific scenario has yet to be resolved. If the CSV file name (excluding the path) is unicode, the routine fails when the actual data is not unicode (i.e., ASCII); just the file name is. For full unicode support, including actual CSV data in unicode, the CharacterSet=Unicode extended property on the connection string should work well in most cases.