ADODB Connection is empty, Unable to read CSV file

637 views Asked by At

I have gotten the code below working with all file types except CSV Files.

I am trying to copy a CSV file into a worksheet and I have gotten myself confused. All help will be appreciated.

The debugger shows:

rsConn = ""
szSQL  = "SELECT * FROM export.csv"

When I hit

rsData.Open szSQL, rsCon, 0, 1, 1

I go to the myError error handler

I have distilled the problem down to these steps but the answer eludes me.

szSQL = "SELECT * FROM export.cvs"

Set rsCon = CreateObject("ADODB.Connection")
Set rsData = CreateObject("ADODB.Recordset")

rsCon.Open szConnect
rsData.Open szSQL, rsCon, 0, 1, 1

'These are the values being passed in.
GetData("export.csv" ,"A1:BE", "BirdFeet", "A1", "sku", True, True

The entire code is here:

Public Sub GetData(SourceFile As Variant, SourceSheet As String, SourceRange As String, _
                                          TargetSheet As String, TargetRange As String, _
                                          TargetSortColumn As String, _
                                          HaveHeader As Boolean, UseHeaderRow As Boolean)

Dim lColumn As Long
    Dim lCount As Long
    Dim lRow As Long

    Dim rsCon As Object
    Dim rsData As Object

    Dim szConnect As String
    Dim szSQL As String

    lRow = Range(TargetRange).Row
    lColumn = Range(TargetRange).Column
' Create the connection string.
If HaveHeader = False Then                                                          'No there is NOT a header row.
    If Val(Application.Version) < 12 Then
        szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                    "Data Source=" & SourceFile & ";" & _
                    "Extended Properties=""Excel 8.0;HDR=No"";"
    Else
        szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "Data Source=" & SourceFile & ";" & _
                    "Extended Properties=""Excel 12.0;HDR=No"";"
    End If
Else                                                                                'Yes there is a Header Row
    If Val(Application.Version) < 12 Then
        szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                    "Data Source=" & SourceFile & ";" & _
                    "Extended Properties=""Excel 8.0;HDR=Yes"";"


    Else
            If (Right(SourceSheet, 4) = ".csv") Then
                szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                            "Data Source=" & SourceFile & ";" & _
                            "Extended Properties=""text; HDR=Yes; FMT=Delimited; IMEX=1;"""
            Else
                szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                            "Data Source=" & SourceFile & ";" & _
                            "Extended Properties=""Excel 12.0;HDR=Yes"";"
            End If
    End If
End If

If SourceSheet = "" Then 
    'Create query strings
    szSQL = "SELECT * FROM " & SourceRange$ & " ORDER BY sku;"

ElseIf SourceSheet = "DiamondAvian" Or SourceSheet = "export.csv" Then

    szSQL = "SELECT * FROM export.csv"

Else

    szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "] WHERE sku <> NULL ORDER BY " & TargetSortColumn & ";"   'THIS WORKS FOR DICIONARY

End If

On Error GoTo SomethingWrong

Set rsCon = CreateObject("ADODB.Connection")
Set rsData = CreateObject("ADODB.Recordset")

rsCon.Open szConnect
rsData.Open szSQL, rsCon, 0, 1, 1
                                                                                     ' Check to make sure we received data and copy the data
If Not rsData.EOF Then

    If HaveHeader = False Then
        Cells(1, 1).CopyFromRecordset rsData
    Else
                                                                                     'Add the header cell in each column if the last argument is True
        If UseHeaderRow Then
            For lCount = 0 To rsData.Fields.Count - 1                                'Builds the Header row one column at a time.
                Cells(lRow, lColumn + lCount).value = rsData.Fields(lCount).Name     'lcount determines the Column to paste header info in.
            Next lCount
        Cells(lRow + 1, lColumn).CopyFromRecordset rsData                            'This is the step that copies and Pastes the data.
        Else
            Cells(lRow + 1, lColumn).CopyFromRecordset rsData
        End If
    End If

Else
    MsgBox "No records returned from : " & SourceFile, vbCritical
End If

rsData.Close                                                                        ' Clean up our Recordset object.
Set rsData = Nothing
rsCon.Close
Set rsCon = Nothing

Exit Sub

SomethingWrong:

MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, vbExclamation, "Error"

On Error GoTo 0

End Sub
1

There are 1 answers

0
David W On BEST ANSWER

The connection string is blank because a wrong parameter is being sent to GetData. Take a look at these code snips:

SourceSheet is the second parameter in the call, but you pass it as the first parameter here:

' Here's the call to GetData
GetData("export.csv" ,"A1:BE", ...

Filename goes in as first parameter...but here's the declaration of GetData

' But look at the declaration...SourceSheet is 2nd param, not 1st...
Public Sub GetData(SourceFile As Variant, SourceSheet As String,...

Now, look at the code that determines your connection string:

' later in code
 If (Right(SourceSheet, 4) = ".csv") Then ' It contains "A1:BE", so your logic goes awry and your connection string ends up incorrect...

Think working out that hiccup will fix your problem.