Hi there,

Instead of using QueryTable, I recommend using ADO to do this.

I hope this code stub helps you work it out?


Private Function ImportCSVData() As Boolean

On Error GoTo ErrorHandler

Dim oConnection As ADODB.Connection
Dim oRecordset As ADODB.Recordset
Dim strSQL As String, strProvider As String, strADOConnection As String
Dim strFullFileName As String
Dim objSheet As Excel.Worksheet
Dim objStartCell As Excel.Range

ImportCSVData = False

' Turn Excel screenupdating off for speed reasons
Excel.Application.ScreenUpdating = False

' File name to do - in a loop perhaps
strFullFileName = "C:\TestData.csv"

' Your sheet name reference to do
Set objSheet = ActiveSheet

' Your range start to do, i.e. go to end & bring in next data
Set objStartCell = objSheet.Cells(objSheet.Range("A2").CurrentRegion. Rows.Count + 1, 1)

If FSO.FileExists(strFullFileName) Then

' Do a simple SQL query based on your data
strSQL = "Select [Unique Code], [2015], [2016], [2017] FROM " & strFullFileName

Set oConnection = New ADODB.Connection

strADOConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & "C:\" & ";" & _
"Extended Properties=""text; HDR=Yes; FMT=Delimited; IMEX=1;"""

oConnection.Open strADOConnection

Set oRecordset = New ADODB.Recordset
oRecordset.ActiveConnection = oConnection
oRecordset.Source = strSQL
oRecordset.Open
objStartCell.CopyFromRecordset oRecordset

oRecordset.Close
oConnection.Close

ImportCSVData = True
End If

CleanUp:
On Error Resume Next

' Always make sure screenupdating is back on
Excel.Application.ScreenUpdating = True
' Clear all object references from memory
Set oConnection = Nothing
Set oRecordset = Nothing
Set objSheet = Nothing
Set objStartCell = Nothing

Exit Function
ErrorHandler:
MsgBox "An unexpected error has occurred" & vbCrLf & Err.Number & " " & Err.Description, _
vbOKOnly + vbInformation, "Import CSV Data"

Err.Clear
GoTo CleanUp
End Function

' This you would typically put into a module called FSO
' You need to reference the Microsoft Scripting Runtime library first
' Select, Tools, References & find the Library in the list and tick it
Public Function FileExists(strFileFullName As String) As Boolean

Dim oFSO As New FileSystemObject

FileExists = oFSO.FileExists(strFileFullName)

Set oFSO = Nothing
End Function