Excel VBA ADO SQL query csv file

[mack1979]

Trying to query a csv file (have to average the records as I'm pulling the results in, averaging over simulations (say 2000 in a file) each of which has ca. 27 groups which need to be reported separately. I have this code which works, but it fails if the csv filename is >64 characters.

Sub extract_results()

    Dim adodb_connection As ADODB.Connection
    Dim adodb_recordset As ADODB.Recordset
    Dim adodb_connection_str As String
    Dim folder As String
    Dim file As String
    Dim file_short As String
    Dim extension As String
    Dim path As String
    Dim path_short As String
    Dim sql_str As String
    Dim group_by_str As String
    Dim i As Integer
    Dim field_list As Range
    Dim column_header As String
    Dim aggregate_function As String
    Dim t As Integer
    Dim calculation_setting As XlCalculation
                    
    calculation_setting = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    t = 0
    Sheets("Time").Activate
    ActiveSheet.Range("Time").Offset(t, 0).Value = Timer
    t = t + 1
        
    Sheets("Input").Activate
    folder = ActiveSheet.Range("folder").Value
    If Mid(folder, Len(folder), 1) <> "\" Then
        folder = folder & "\"
    End If
    file = ActiveSheet.Range("file").Value
    extension = ActiveSheet.Range("extension").Value
    If Mid(extension, 1, 1) <> "." Then
        extension = "." & extension
    End If
    path = folder & file & extension
        
    Set adodb_connection = New ADODB.Connection
    adodb_connection_str = _
        "provider=Microsoft.Jet.OLEDB.4.0;;" & _
        "data source='" & folder & "';" & _
        "extended properties=""text;HDR=Yes;FMT=Delimited(,)"""
    adodb_connection.Open adodb_connection_str
    
    Sheets("Time").Activate
    ActiveSheet.Range("Time").Offset(t, 0).Value = Timer
    t = t + 1
    
    If Len(file & extension) > 64 Then
        file_short = Mid(file, 1, 60)
        path_short = folder & file_short & extension
        FileCopy path, path_short
        file = file_short
    End If
    
    Sheets("Time").Activate
    ActiveSheet.Range("Time").Offset(t, 0).Value = Timer
    t = t + 1
    
    Sheets("query").Activate
    Set field_list = ActiveSheet.Range("field_list")
    sql_str = ""
    group_by_str = ""
    i = 0
    column_header = field_list.Offset(i, 0).Value
    aggregate_function = field_list.Offset(i, 2).Value
    While column_header <> ""
        column_header = "[" & column_header & "]"
        If sql_str = "" Then
            sql_str = "SELECT "
        Else
            sql_str = sql_str & ", "
        End If
        If aggregate_function = "GROUP BY" Then
            sql_str = sql_str & column_header
            If group_by_str <> "" Then
                group_by_str = group_by_str & ", "
            End If
            group_by_str = group_by_str & column_header
        Else
            sql_str = sql_str & aggregate_function & "(" & column_header & ")"
        End If
        i = i + 1
        column_header = field_list.Offset(i, 0).Value
        aggregate_function = field_list.Offset(i, 2).Value
    Wend
    sql_str = sql_str & " FROM " & "[" & file & extension & "]"
    If group_by_str <> "" Then
        sql_str = sql_str & " GROUP BY " & group_by_str
    End If
    sql_str = sql_str & ";"
    
    Sheets("Time").Activate
    ActiveSheet.Range("Time").Offset(t, 0).Value = Timer
    t = t + 1
    
    Set adodb_recordset = New ADODB.Recordset
    adodb_recordset.Open sql_str, adodb_connection
        
    Sheets("Time").Activate
    ActiveSheet.Range("Time").Offset(t, 0).Value = Timer
    t = t + 1
    
    Sheets("Query result").Range("query_result").CopyFromRecordset adodb_recordset
    
    Sheets("Time").Activate
    ActiveSheet.Range("Time").Offset(t, 0).Value = Timer
    t = t + 1
          
    adodb_recordset.Close
    adodb_connection.Close
    Set adodb_connection = Nothing
    Set adodb_recordset = Nothing
    
    Sheets("Input").Activate
    Application.Calculation = calculation_setting
    Application.ScreenUpdating = True
    Application.Calculate
          
    MsgBox ("Done")

End Sub

The filename is determined by the source system. I can cut it slightly, but at the moment my only workaround is using VBA to copy the file, rename the copy to something shorter before querying it.

Filename something like "TimeZeroPV_TimeZeroPV Output - 2000 sims - ASL@600~aslh~company~funds~rbsgroup.csv" and quite long paths too, but it seems to only be the filename length which affects it.

 

[mack1979]

Bump. Anyone?

 

[RoryA]

Unfortunately 64 characters is a fairly common limit on table names, which is how you have to use the text file name with ADO. I'd stick with the workaround you have, but you could also save the csv as a workbook instead, since the table name then would be the sheet name (which has to be 31 characters or less).

 

[mack1979]

I was really hoping you weren't going to say that. I loathe the workaround of copying the file. We have a degree of control over the filename, so I guess we'll do what we can to reduce it and make sure no-one ever tries to increase it. Sadly we can't save the file as Excel because it is produced by the software, outside our control.

Thanks for the help!

 

[Norie]

Couldn't you rename the file, do the ADO and then change the name back to what it originally was?