VBA Macro read user selected field names from CSV file - excel

Question

I have a sample.csv file with four fields/columns:
Date
City
State
Amount
Below is my code which retrieves all four fields of the data:
Sub LoadFromFile()
Dim fileName As String, folder As String
folder = "d:\Sample.csv"
fileName = ActiveCell.Value
ActiveCell.Offset(1, 0).Range("A1").Select
With ActiveSheet.QueryTables _
.Add(Connection:="TEXT;" & folder & fileName, Destination:=ActiveCell)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
My requirement is to display only three fields/columns: Date, City and Amount. How can I do that?

Answer 1

Sub CSVData()
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Set con = New ADODB.Connection
Set rs = New ADODB.Recordset
Dim currentDataFilePath As String
Dim currentDataFileName As String
Dim nextRow As Integer
Dim emptystr As String
'"H:\projectfiles\csv\", "Book.csv"
currentDataFilePath = ("H:\projectfiles\csv\")
currentDataFileName = ("Book.csv")
emptystr = "NULL"
con.Provider = "Microsoft.Ace.OLEDB.12.0"
con.ConnectionString = "Data Source=" & currentDataFilePath & ";" & "Extended Properties=""text;HDR=Yes;FMT=Delimited;"""
'MsgBox currentDataFilePath
con.Open
rs.Open "SELECT * FROM [" & currentDataFileName & "] ", con
rs.MoveFirst
'nextRow = Worksheets("Sheet3").UsedRange.Rows.Count + 1
'Worksheets("Sheet3").Cells(nextRow, 1).CopyFromRecordset rs
'MsgBox rs.RecordCount
With rs
Do Until .EOF
'check the field is not null before process
If Not IsNull(rs(0)) Then
custordernum = rs(0)
End If
If Not IsNull(rs(1)) Then
ContactNAme = "" & Replace(rs(1), "'", " ")
Else
ContactNAme = emptystr
End If
If Not IsNull(rs(2)) Then
colladd1 = "" & Replace(rs(2), "'", " ")
Else
colladd1 = emptystr
End If
MsgBox colladd1
.MoveNext
Loop
End With
rs.Close
con.Close
End Sub

Answer 2

This is your alternative doing exactly what you want so you can copy and change to your specification
Sub CSVDataBok()
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Set con = New ADODB.Connection
Set rs = New ADODB.Recordset
Dim currentDataFilePath As String
Dim currentDataFileName As String
Dim nextRow As Integer
Dim emptystr As String
'"H:\projectfiles\csv\", "Book.csv"
currentDataFilePath = ("H:\resources\")
currentDataFileName = ("Book2.csv")
emptystr = "NULL"
con.Provider = "Microsoft.Ace.OLEDB.12.0"
con.ConnectionString = "Data Source=" & currentDataFilePath & ";" & "Extended Properties=""text;HDR=Yes;FMT=Delimited;"""
'MsgBox currentDataFilePath
con.Open
rs.Open "SELECT Date,City,State,Amount FROM [" & currentDataFileName & "] ", con
rs.MoveFirst
nextRow = Worksheets("Sheet3").UsedRange.Rows.Count + 1
Worksheets("Sheet3").Cells(nextRow, 1).CopyFromRecordset rs
rs.Close
con.Close
End Sub