reading from CSV files and appending to sheet.

[crgeorge64]

Hello,

I am new to the forum and have been learning VBA on my own and with books. I have a task where I need to read data from several CSV files contained in a directory. The number of files varies but all of the file I need, start with "SPL" and are numbered sequentially, such as SPL0000.csv, SPL0002.csv, etc. Also note that there is no header in these files but the data is in 3 columns. the columns are dateandtime / a code that could be "P" or "S" / a numeric value for which for which I need the data for further analysis. There are other CSV files in the same directory that I don't need for this purpose.

The intention is to create a loop such that the code will loop (look at) each of the CSV files, read the data and append the data into a particular sheet in the workbook. When I try to run the code It just seems to keep trying to read from the initial file.

Here is my code. It should be noted that I'm no expert and would appreciate any help getting in the right direction. Thanks.

Public Sub QueryTextFile()
Dim rsData As ADODB.Recordset
Dim sConnect As String
Dim sSQL As String
Dim FileDirectory
Dim sh As Worksheet, sPath As String, sName As String
Dim startselect As Range
Set sh = ActiveSheet
Set startselect = Sheet1.Range("A1")
Workbooks("ADO Sample Code.xlsm").Activate
Sheets("Old").Activate
sPath = "J:\Planning\Community Mobility\Speed Trailer Data\2009\Signs\2009-04-16 Eureka Ave bet Wicklow Rd and Palmetto St\Downloads\"
sName = Dir(sPath & "SPL*.csv")
'Selection.CurrentRegion.ClearContents
Do While sName <> ""
'Create the connection string
'sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
' "Data Source=J:\Planning\Community Mobility\Speed Trailer Data\2009\Signs\2009-04-16 Eureka Ave bet Wicklow Rd and Palmetto St\Downloads\;" & _
' "Extended Properties=""Text;HDR=No"";"
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=J:\Planning\Community Mobility\Speed Trailer Data\2009\Signs\2009-04-16 Eureka Ave bet Wicklow Rd and Palmetto St\Downloads\;" & _
"Extended Properties=""Text;HDR=No;FMT=Delimited"";"
'Create the SQL statement
'sSQL = "SELECT * FROM SPL0000.csv WHERE [F2]='P';"
sSQL = "SELECT * FROM " & sName & " WHERE [F2]='P';"
Debug.Print sName
Set rsData = New ADODB.Recordset
rsData.Open sSQL, sConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
'Check to make sure we received data.
If Not rsData.EOF Then
'Dump the returned data onto Sheet1.
'Sheet1.Range("A1").CopyFromRecordset rsData
startselect.CopyFromRecordset rsData
Else
MsgBox "No records returned.", vbCritical
End If
'Clean up our Recordset object.
rsData.Close
Set rsData = Nothing
Dim LastRow As Integer
Workbooks("ADO Sample Code.xlsm").Activate
Sheets("Old").Activate
LastRow = ActiveSheet.UsedRange.Rows.Count
LastRow = LastRow + 1
'MsgBox "The last row is " & LastRow
startselect = Range("A" & LastRow).Select
Loop
End Sub

 

[ravishankar]

Hi
try these codes

Sub george()
Dim z  As Long, e As Long, g As Long
Dim f As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Sheet1").Select
Cells(1, 1) = "=cell(""filename"")"
Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
Cells(2, 1).Select
f = Dir(Cells(1, 2) & "*.xls")
Do While Len(f) > 0
If Left(f, 3) = "SPL" Then
ActiveCell.Formula = f
ActiveCell.Offset(1, 0).Select
f = Dir()
End If
Loop
z = Cells(Rows.Count, 1).End(xlUp).Row
For e = 2 To z
If Cells(e, 1) <> ActiveWorkbook.Name Then
x = Cells(Rows.Count, 3).End(xlUp).Row + 2
Workbooks.Open Filename:=Cells(1, 2) & Cells(e, 1)
ActiveSheet.UsedRange.Copy
ActiveWorkbook.Close False
Cells(x, 2) = Cells(e, 1)
Range("C" & x).PasteSpecial xlPasteAll
End If
Next e
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "collating is complete."
End Sub

It lists all files in the folder with spl in their name and opens each file, copies data from first sheet and pastes to master sheet
ravi