Small macro - save a week of work

[theta]

Hi All

I have just been given 225 CSV files that need to be imported, text to columns (comma delimited) and pasted one under the other - to form one continuous worksheet

I need to get a macro in place where I can have the open file dialog - select the CSV - macro finds next empty row - imports the CSV to this point - splits the file by comma.... then the whole process can be repeated

Any ideas / help?

Should be a simple import VBA, with a find next row and then text to column command?

 

[theta]

Macro recorded gives me alot of excess that I do not need, and not very flexible or elegant

 

[theta]

Have been trying to use this, but it imports blank!

Sub GetTextFileData(strSQL As String, strFolder As String, rngTargetCell As Range)
' example: GetTextFileData "SELECT * FROM filename.txt", _
              "C:\FolderName", Range("A3")
' example: GetTextFileData "SELECT * FROM filename.txt WHERE fieldname = 'criteria'", _
              "C:\FolderName", Range("A3")
              
Dim cn As ADODB.Connection, rs As ADODB.Recordset, f As Integer
    If rngTargetCell Is Nothing Then Exit Sub
    Set cn = New ADODB.Connection
    On Error Resume Next
    cn.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
        "Dbq=" & strFolder & ";" & _
        "Extensions=asc,csv,tab,txt;"
    On Error GoTo 0
    If cn.State <> adStateOpen Then Exit Sub
    Set rs = New ADODB.Recordset
    On Error Resume Next
    rs.Open strSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
    On Error GoTo 0
    If rs.State <> adStateOpen Then
        cn.Close
        Set cn = Nothing
        Exit Sub
    End If
    ' the field headings
    For f = 0 To rs.Fields.Count - 1
        rngTargetCell.Offset(0, f).Formula = rs.Fields(f).Name
    Next f
    rngTargetCell.Offset(1, 0).CopyFromRecordset rs ' works in Excel 2000 or later
    'RS2WS rs, rngTargetCell ' works in Excel 97 or earlier
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub
Sub TestGetTextFileData()
Dim strFilePath As String, strFilename As String, strFullPath As String
Dim oConn As String, oRS As Object, oFSObj As Object
    Application.ScreenUpdating = False
'    Workbooks.Add
strFullPath = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please selec text file...")
If strFullPath = "False" Then Exit Sub  'User pressed Cancel on the open file dialog
    Set oFSObj = CreateObject("SCRIPTING.FILESYSTEMOBJECT")
    strFilePath = oFSObj.GetFile(strFullPath).ParentFolder.Path
    strFilename = oFSObj.GetFile(strFullPath).Name
    GetTextFileData "SELECT * FROM " & strFilename, oConn, Range("A3")
'    GetTextFileData "SELECT * FROM filename.txt WHERE fieldname = 'criteria'", _
        "C:\FolderName", Range("A3")
    ActiveWorkbook.Saved = True
    
End Sub